SystemOrganization addCategory: #'PetitSmalltalk-Core'! SystemOrganization addCategory: #'PetitSmalltalk-Tests'! PPCompositeParser subclass: #PPSmalltalkGrammar instanceVariableNames: 'array arrayLiteral arrayLiteralArray assignment assignmentToken binary binaryExpression binaryMessage binaryMethod binaryPragma binaryToken block blockArgument blockArguments blockArgumentsEmpty blockBody blockSequence blockSequenceEmpty byteLiteral cascadeExpression cascadeMessage char charLiteral charToken epsilon expression falseLiteral falseToken identifier identifierToken keyword keywordExpression keywordMessage keywordMethod keywordPragma keywordToken literal message method methodDeclaration methodSequence multiword nilLiteral nilToken number numberLiteral numberToken parens pragma pragmaMessage pragmas primary return sequence statements string stringLiteral stringToken symbol symbolLiteral temporaries trueLiteral trueToken unary unaryExpression unaryMessage unaryMethod unaryPragma unaryToken variable symbolLiteralArray byteLiteralArray arrayItem' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Core'! PPSmalltalkGrammar subclass: #PPSmalltalkCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Core'! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'TestRunner 11/7/2009 13:45'! array ^ super array ==> [ :nodes | (self buildArray: nodes second) left: nodes first start; right: nodes last start; yourself ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:41'! arrayLiteral ^ super arrayLiteral ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: false ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:41'! arrayLiteralArray ^ super arrayLiteralArray ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: false ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 11/5/2009 10:42'! binaryExpression ^ super binaryExpression map: [ :receiver :messages | self build: receiver messages: messages ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 11/5/2009 11:20'! block ^ super block map: [ :left :block :right | block left: left start; right: right start ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockArgument ^ super blockArgument ==> #second! ! !PPSmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 11/5/2009 10:42'! blockArgumentsEmpty ^ super blockArgumentsEmpty ==> [ :nodes | #() ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 11/5/2009 10:42'! blockBody ^ super blockBody ==> [ :nodes | RBBlockNode arguments: nodes first body: nodes last ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockSequenceEmpty ^ super blockSequenceEmpty ==> [ :nodes | RBSequenceNode statements: #() ]! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'TestRunner 11/5/2009 10:36'! build: aNode assignment: anArray ^ anArray isEmpty ifTrue: [ aNode ] ifFalse: [ anArray reverse inject: aNode into: [ :result :each | RBAssignmentNode variable: each first value: result position: each second start ] ]! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'lr 11/5/2009 10:44'! build: aNode cascade: anArray | messages | ^ (anArray isNil or: [ anArray isEmpty ]) ifTrue: [ aNode ] ifFalse: [ messages := OrderedCollection new: anArray size + 1. messages addLast: aNode. anArray do: [ :each | messages addLast: (self build: aNode receiver messages: (Array with: each second)) ]. RBCascadeNode messages: messages ]! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'lr 11/5/2009 10:44'! build: aNode messages: anArray ^ (anArray isNil or: [ anArray isEmpty ]) ifTrue: [ aNode ] ifFalse: [ anArray inject: aNode into: [ :rec :msg | msg isNil ifTrue: [ rec ] ifFalse: [ RBMessageNode receiver: rec selectorParts: msg first arguments: msg second ] ] ]! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'TestRunner 11/5/2009 11:14'! build: aTempCollection sequence: aStatementCollection | nodes periods result | nodes := OrderedCollection new. periods := OrderedCollection new. aStatementCollection do: [ :each | (each isKindOf: RBProgramNode) ifTrue: [ nodes add: each ] ifFalse: [ periods add: each start ] ]. result := RBSequenceNode statements: nodes. result periods: periods. aTempCollection isEmpty ifFalse: [ result leftBar: aTempCollection first start temporaries: aTempCollection second rightBar: aTempCollection last start ]. ^ result! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'TestRunner 11/7/2009 13:44'! buildArray: aStatementCollection | nodes periods result | nodes := OrderedCollection new. periods := OrderedCollection new. aStatementCollection do: [ :each | (each isKindOf: RBProgramNode) ifTrue: [ nodes add: each ] ifFalse: [ periods add: each start ] ]. result := RBArrayNode statements: nodes. result periods: periods. ^ result! ! !PPSmalltalkCompiler methodsFor: 'private' stamp: 'TestRunner 10/23/2009 16:49'! buildString: aString (aString isEmpty not and: [ aString first = $# ]) ifTrue: [ ^ (self buildString: aString allButFirst) asSymbol ]. (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) ifTrue: [ ^ aString ]. ^ (aString copyFrom: 2 to: aString size - 1) copyReplaceAll: '''''' with: ''''! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:41'! byteLiteral ^ super byteLiteral ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: true ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:41'! byteLiteralArray ^ super byteLiteralArray ==> [ :nodes | RBLiteralArrayNode startPosition: nodes first start contents: nodes second stopPosition: nodes last start isByteArray: true ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 11/5/2009 10:43'! cascadeExpression ^ super cascadeExpression map: [ :receiver :messages | self build: receiver cascade: messages ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:28'! charLiteral ^ super charLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: token value second start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:33'! expression ^ super expression map: [ :vars :expr | self build: expr assignment: vars ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:29'! falseLiteral ^ super falseLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: false start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 11/5/2009 10:43'! keywordExpression ^ super keywordExpression map: [ :receiver :message | self build: receiver messages: (Array with: message) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:55'! method ^ super method map: [ :declaration :body | declaration pragmas: body first. declaration body: (self build: body second sequence: body third). declaration ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:37'! methodDeclaration ^ super methodDeclaration ==> [ :nodes | RBMethodNode selectorParts: nodes first arguments: nodes second ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:29'! nilLiteral ^ super nilLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: nil start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 13:33'! numberLiteral ^ super numberLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBNumberLiteralToken value: (Number readFrom: token value) start: token start stop: token stop source: token value) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:38'! parens ^ super parens map: [ :open :expr :close | expr addParenthesis: (open start to: close start) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:41'! pragma ^ super pragma ==> [ :nodes | (RBPragmaNode selectorParts: nodes second first arguments: nodes second second) left: nodes first start; right: nodes last start; yourself ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:41'! return ^ super return map: [ :token :expr | RBReturnNode return: token start value: expr ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 11/5/2009 10:41'! sequence ^ super sequence map: [ :temps :stats | self build: temps sequence: stats ]! ! !PPSmalltalkCompiler methodsFor: 'accessing' stamp: 'lr 11/5/2009 10:54'! start ^ ([ :stream | stream collection ] asParser and , super start) map: [ :source :node | node source: source ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:30'! stringLiteral ^ super stringLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: (self buildString: token value) start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:31'! symbolLiteral ^ super symbolLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: (self buildString: token value) start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:45'! symbolLiteralArray ^ super symbolLiteralArray ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: (self buildString: token value) asSymbol start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'TestRunner 11/5/2009 11:29'! trueLiteral ^ super trueLiteral ==> [ :token | RBLiteralValueNode literalToken: (RBLiteralToken value: true start: token start stop: token stop) ]! ! !PPSmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 11/5/2009 10:43'! unaryExpression ^ super unaryExpression map: [ :receiver :messages | self build: receiver messages: messages ]! ! !PPSmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! variable ^ super variable ==> [ :token | RBVariableNode identifierToken: token ]! ! !PPSmalltalkGrammar class methodsFor: 'parsing' stamp: 'lr 9/27/2009 12:42'! parseExpression: aString ^ self new expression parse: aString asParserStream! ! !PPSmalltalkGrammar class methodsFor: 'parsing' stamp: 'lr 9/27/2009 12:42'! parseMethod: aString ^ self new method parse: aString asParserStream! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! array ^ ${ asParser token , statements , $} asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:39'! arrayItem ^ literal / symbolLiteralArray / arrayLiteralArray / byteLiteralArray! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:32'! arrayLiteral ^ '#(' asParser token , arrayItem star , $) asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:37'! arrayLiteralArray ^ $( asParser token , arrayItem star , $) asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! assignment ^ variable , assignmentToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! assignmentToken ^ (':=' asParser / '_' asParser) token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! binary ^ $~ asParser / $- asParser / $!! asParser / $@ asParser / $% asParser / $& asParser / $* asParser / $+ asParser / $= asParser / $\ asParser / $| asParser / $? asParser / $/ asParser / $> asParser / $< asParser / $, asParser , ($~ asParser / $!! asParser / $@ asParser / $% asParser / $& asParser / $* asParser / $+ asParser / $= asParser / $\ asParser / $| asParser / $? asParser / $/ asParser / $> asParser / $< asParser / $, asParser) star! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! binaryExpression ^ unaryExpression , binaryMessage star! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! binaryMessage ^ (binaryToken , unaryExpression) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 9/27/2009 12:42'! binaryMethod ^ (binaryToken , variable) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'TestRunner 10/23/2009 17:34'! binaryPragma ^ (binaryToken , arrayItem) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! binaryToken ^ binary token! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! block ^ $[ asParser token , blockBody , $] asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockArgument ^ $: asParser token , variable! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockArguments ^ blockArgument plus! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockArgumentsEmpty ^ epsilon! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 11/5/2009 11:19'! blockBody ^ (blockArguments , $| asParser token , blockSequence) / (blockArguments , epsilon , blockSequenceEmpty) / (blockArgumentsEmpty , epsilon , blockSequence)! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockSequence ^ sequence! ! !PPSmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 9/27/2009 12:42'! blockSequenceEmpty ^ epsilon! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:38'! byteLiteral ^ '#[' asParser token , numberLiteral star , $] asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:31'! byteLiteralArray ^ $[ asParser token , numberLiteral star , $] asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! cascadeExpression ^ keywordExpression , cascadeMessage star! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! cascadeMessage ^ $; asParser token , message! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! char ^ $$ asParser , #any asParser! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! charLiteral ^ charToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! charToken ^ char token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 11/20/2009 15:31'! epsilon ^ nil asParser! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! expression ^ assignment star , cascadeExpression! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! falseLiteral ^ falseToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! falseToken ^ ('false' asParser , #word asParser not) token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 11/9/2009 18:52'! identifier ^ #letter asParser , #word asParser star! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! identifierToken ^ identifier token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! keyword ^ identifier , $: asParser! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! keywordExpression ^ binaryExpression , keywordMessage optional! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! keywordMessage ^ (keywordToken , binaryExpression) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 9/27/2009 12:42'! keywordMethod ^ (keywordToken , variable) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'TestRunner 10/23/2009 17:35'! keywordPragma ^ (keywordToken , arrayItem) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! keywordToken ^ keyword token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! literal ^ trueLiteral / falseLiteral / nilLiteral / charLiteral / numberLiteral / stringLiteral / symbolLiteral / arrayLiteral / byteLiteral! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! message ^ keywordMessage / binaryMessage / unaryMessage! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! method ^ methodDeclaration , methodSequence! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! methodDeclaration ^ keywordMethod / unaryMethod / binaryMethod! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! methodSequence ^ ($. asParser token star , pragmas , temporaries , pragmas , statements) ==> [ :nodes | Array with: nodes second , nodes fourth with: nodes third with: nodes fifth ]! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! multiword ^ keyword plus! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! nilLiteral ^ nilToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! nilToken ^ ('nil' asParser , #word asParser not) token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 11/11/2009 21:19'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) and , [ :stream | [ Number readFrom: stream ] on: Error do: [ :err | PPFailure reason: err messageText at: stream position ] ] asParser! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! numberLiteral ^ numberToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! numberToken ^ number token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! parens ^ $( asParser token , expression , $) asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! pragma ^ $< asParser token , pragmaMessage , $> asParser token! ! !PPSmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'lr 9/27/2009 12:42'! pragmaMessage ^ keywordPragma / unaryPragma / binaryPragma! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! pragmas ^ pragma star! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! primary ^ literal / variable / block / parens / array! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! return ^ $^ asParser token , expression! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! sequence ^ temporaries , statements! ! !PPSmalltalkGrammar methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! start ^ method! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 11/20/2009 17:37'! statements ^ ((return , $. asParser token star) ==> [ :nodes | (Array with: nodes first) , (nodes last) ]) / ((expression wrapped , $. asParser token plus , statements) ==> [ :nodes | (Array with: nodes first) , (nodes second) , (nodes last) ]) / ((expression wrapped , $. asParser token star) ==> [ :nodes | (Array with: nodes first) , (nodes second) ]) / ($. asParser token star)! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! string ^ $' asParser , (($' asParser , $' asParser) / $' asParser negate) star , $' asParser! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! stringLiteral ^ stringToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! stringToken ^ string token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! symbol ^ unary / binary / multiword / string! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! symbolLiteral ^ ($# asParser , symbol) token! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'TestRunner 10/23/2009 17:31'! symbolLiteralArray ^ symbol token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 11/5/2009 11:01'! temporaries ^ ($| asParser token , variable star , $| asParser token) optional ==> [ :nodes | nodes ifNil: [ #() ] ]! ! !PPSmalltalkGrammar methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! tokenParser ^ PPSmalltalkTokenParser! ! !PPSmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 9/27/2009 12:42'! trueLiteral ^ trueToken! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! trueToken ^ ('true' asParser , #word asParser not) token! ! !PPSmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/27/2009 12:42'! unary ^ identifier , $: asParser not! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! unaryExpression ^ primary , unaryMessage star! ! !PPSmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/27/2009 12:42'! unaryMessage ^ unaryToken ==> [ :node | Array with: (Array with: node) with: Array new ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 9/27/2009 12:42'! unaryMethod ^ identifierToken ==> [ :node | Array with: (Array with: node) with: Array new ]! ! !PPSmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'TestRunner 10/23/2009 16:35'! unaryPragma ^ identifierToken ==> [ :node | Array with: (Array with: node) with: (Array new) ]! ! !PPSmalltalkGrammar methodsFor: 'token' stamp: 'lr 9/27/2009 12:42'! unaryToken ^ unary token! ! !PPSmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/27/2009 12:42'! variable ^ identifierToken! ! TestResource subclass: #PPGrammarResource instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Tests'! !PPGrammarResource methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! parserAt: aClass ^ parsers at: aClass name ifAbsentPut: [ aClass new ]! ! !PPGrammarResource methodsFor: 'running' stamp: 'lr 9/27/2009 12:42'! setUp super setUp. parsers := Dictionary new! ! PPTokenParser subclass: #PPSmalltalkTokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Core'! !PPSmalltalkTokenParser methodsFor: 'hooks' stamp: 'lr 9/27/2009 12:42'! consumeSpaces: aStream [ super consumeSpaces: aStream. aStream peek == $" ] whileTrue: [ aStream next. [ aStream atEnd not and: [ aStream next = $" ] ] whileFalse ]! ! TestCase subclass: #PPGrammarTest instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Tests'! !PPGrammarTest class methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! isAbstract ^ self name = #PPGrammarTest! ! !PPGrammarTest class methodsFor: 'accessing' stamp: 'lr 10/23/2009 16:22'! packageNamesUnderTest ^ #('PetitSmalltalk')! ! !PPGrammarTest class methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! resources ^ Array with: PPGrammarResource! ! !PPGrammarTest methodsFor: 'parsing' stamp: 'lr 9/27/2009 12:42'! parse: aString self parse: aString rule: #start! ! !PPGrammarTest methodsFor: 'parsing' stamp: 'TestRunner 10/23/2009 16:38'! parse: aString rule: aSymbol | production | production := self parser. aSymbol = #start ifFalse: [ production := production instVarNamed: aSymbol ]. result := production end parse: aString asParserStream. self deny: result isFailure description: 'Unable to parse ' , aString printString! ! !PPGrammarTest methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! parser ^ PPGrammarResource current parserAt: self parserClass! ! !PPGrammarTest methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! parserClass self subclassResponsibility! ! PPGrammarTest subclass: #PPSmalltalkClassesTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Tests'! !PPSmalltalkClassesTests commentStamp: 'lr 3/26/2009 16:09' prior: 0! Evalaute the following code to verify the complete image. PackageOrganizer default packages inject: LAPackagesTests new into: [ :test :package | [ test verifyPackage: package packageName ] on: TestResult resumableFailure do: [ :err | err resume ] ]! !PPSmalltalkClassesTests methodsFor: 'private' stamp: 'lr 9/27/2009 12:43'! assert: aBoolean description: aString self assert: aBoolean description: aString resumable: true! ! !PPSmalltalkClassesTests methodsFor: 'accessing' stamp: 'lr 10/25/2009 23:30'! parserClass ^ PPSmalltalkCompiler! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testCollection self verifyClass: Collection. self verifyClass: Array. self verifyClass: Set. self verifyClass: Dictionary. self verifyClass: Bag. self verifyClass: OrderedCollection. self verifyClass: SortedCollection! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'TestRunner 10/23/2009 18:13'! testDateAndTime self verifyClass: DateAndTime. self verifyClass: Duration! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'TestRunner 10/23/2009 18:12'! testException self verifyClass: Exception. self verifyClass: Notification. self verifyClass: Warning. self verifyClass: Error! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'TestRunner 10/23/2009 18:12'! testFundamental self verifyClass: Object. self verifyClass: Boolean. self verifyClass: True. self verifyClass: False. self verifyClass: Character ! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'TestRunner 10/23/2009 18:10'! testMagnitude self verifyClass: Magnitude. self verifyClass: Number. self verifyClass: Integer. self verifyClass: Float. self verifyClass: Fraction! ! !PPSmalltalkClassesTests methodsFor: 'testing' stamp: 'TestRunner 10/23/2009 18:14'! testStream self verifyClass: Stream. self verifyClass: ReadStream. self verifyClass: WriteStream! ! !PPSmalltalkClassesTests methodsFor: 'private' stamp: 'TestRunner 10/23/2009 18:15'! verifyClass: aClass aClass selectors do: [ :selector | self verifyClass: aClass selector: selector ] displayingProgress: aClass name. aClass isMeta ifFalse: [ self verifyClass: aClass class ]! ! !PPSmalltalkClassesTests methodsFor: 'private' stamp: 'TestRunner 11/5/2009 13:30'! verifyClass: aClass selector: aSelector "Verifies that the method aSelector in aClass parses the same using the standard refactoring parser and the language boxes parser. Methods that contain float literals are ignored, since they do not reproduce well. Furthermore methods with pragmas are not actually compared as they might pretty print differently." | source original other | source := aClass sourceCodeAt: aSelector. source isNil ifTrue: [ ^ self ]. original := aClass parseTreeFor: aSelector. original isNil ifTrue: [ ^ self ]. original nodesDo: [ :each | each comments: nil ]. other := self parser parse: source asParserStream. source := aClass name , '>>#' , original selector. other isFailure ifTrue: [ self assert: false description: source ] ifFalse: [ self assert: original formattedCode = other formattedCode description: source ]. original nodesDo: [ :originalNode | (originalNode isSequence or: [ originalNode isPragma or: [ originalNode parent notNil and: [ originalNode parent isCascade or: [ originalNode parent isPragma ] ] ] ]) ifFalse: [ | otherNode | otherNode := other whichNodeIsContainedBy: originalNode sourceInterval. self assert: (originalNode = otherNode or: [ originalNode = otherNode parent ]) ] ]! ! PPGrammarTest subclass: #PPSmalltalkGrammarTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Tests'! PPSmalltalkGrammarTests subclass: #PPSmalltalkCompilerTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitSmalltalk-Tests'! !PPSmalltalkCompilerTests methodsFor: 'private' stamp: 'TestRunner 10/23/2009 16:36'! assert: aNode format: aString aNode isCollection ifFalse: [ ^ self assert: (Array with: aNode) format: (Array with: aString) ]. self assert: aNode size = aString size. aNode with: aString do: [ :node :string | self assert: node formattedCode withBlanksTrimmed = string ]! ! !PPSmalltalkCompilerTests methodsFor: 'accessing' stamp: 'lr 10/25/2009 23:30'! parserClass ^ PPSmalltalkCompiler! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock1 super testArgumentsBlock1. self assert: result isBlock. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock2 super testArgumentsBlock2. self assert: result isBlock. self assert: result arguments size = 2. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock3 super testArgumentsBlock3. self assert: result isBlock. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral1 super testArrayLiteral1. self assert: result isLiteral. self assert: result value = #()! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral10 super testArrayLiteral10. self assert: result isLiteral. self assert: result value = #(#(1 2 ) #(1 2 3 ) )! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral11 super testArrayLiteral11. self assert: result isLiteral. self assert: result value size = 2. self assert: (result value first isKindOf: ByteArray). self assert: result value first size = 2. self assert: (result value last isKindOf: ByteArray). self assert: result value last size = 3! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'TestRunner 10/23/2009 17:44'! testArrayLiteral2 super testArrayLiteral2. self assert: result isLiteral. self assert: result value = #(1)! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral3 super testArrayLiteral3. self assert: result isLiteral. self assert: result value = #(1 2 )! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral4 super testArrayLiteral4. self assert: result isLiteral. self assert: result value = #(true false nil )! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral5 super testArrayLiteral5. self assert: result isLiteral. self assert: result value = #($a )! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral6 super testArrayLiteral6. self assert: result isLiteral. self assert: result value = #(1.2 )! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral7 super testArrayLiteral7. self assert: result isLiteral. self assert: result value = #(#size #at: #at:put: #'==' ). result value do: [ :each | self assert: each isSymbol ]! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral8 super testArrayLiteral8. self assert: result isLiteral. self assert: result value = #('baz' ). self assert: result value first isString. self assert: result value first isSymbol not! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral9 super testArrayLiteral9. self assert: result isLiteral. self assert: result value = #(#(1 ) 2 )! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment1 super testAssignment1. self assert: result isLiteral. self assert: result value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment2 super testAssignment2. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isLiteral. self assert: result value value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment3 super testAssignment3. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isAssignment. self assert: result value variable isVariable. self assert: result value variable name = 'b'. self assert: result value value isLiteral. self assert: result value value value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment4 super testAssignment4. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isLiteral. self assert: result value value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment5 super testAssignment5. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isAssignment. self assert: result value variable isVariable. self assert: result value variable name = 'b'. self assert: result value value isLiteral. self assert: result value value value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryExpression1 super testBinaryExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryExpression2 super testBinaryExpression2. self assert: result isMessage. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver arguments size = 1. self assert: result receiver arguments first isLiteral. self assert: result receiver arguments first value = 2. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 3! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod1 super testBinaryMethod1. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod2 super testBinaryMethod2. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod3 super testBinaryMethod3. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod4 super testBinaryMethod4. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral1 super testByteLiteral1. self assert: result isLiteral. self assert: (result value isKindOf: ByteArray). self assert: result value isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral2 super testByteLiteral2. self assert: result isLiteral. self assert: (result value isKindOf: ByteArray). self assert: result value size = 1. self assert: result value first = 0! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral3 super testByteLiteral3. self assert: result isLiteral. self assert: (result value isKindOf: ByteArray). self assert: result value size = 1. self assert: result value first = 255! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral4 super testByteLiteral4. self assert: result isLiteral. self assert: (result value isKindOf: ByteArray). self assert: result value size = 2. self assert: result value first = 1. self assert: result value last = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral5 super testByteLiteral5. self assert: result isLiteral. self assert: (result value isKindOf: ByteArray). self assert: result value size = 3. self assert: result value first = 10. self assert: result value second = 63. self assert: result value last = 255! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression1 super testCascadeExpression1. self assert: result isCascade. self assert: result receiver isLiteral. self assert: result messages size = 2. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #abs. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #negated! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression2 super testCascadeExpression2. self assert: result isCascade. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver selector = #abs. self assert: result messages size = 3. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #negated. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #raisedTo:. self assert: result messages third receiver = result receiver. self assert: result messages third selector = #negated! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression3 super testCascadeExpression3. self assert: result isCascade. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result messages size = 2. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #+. self assert: result messages first arguments size = 1. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #-. self assert: result messages second arguments size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral1 super testCharLiteral1. self assert: result isLiteral. self assert: result value = $a! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral2 super testCharLiteral2. self assert: result isLiteral. self assert: result value = Character space! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral3 super testCharLiteral3. self assert: result isLiteral. self assert: result value = $$! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment1 super testComment1. self assert: result isMessage. self assert: result receiver isValue. self assert: result selector = #+. self assert: result arguments first isValue! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment2 super testComment2. self assert: result isMessage. self assert: result receiver isValue. self assert: result selector = #+. self assert: result arguments first isValue! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment3 super testComment3. self assert: result isMessage. self assert: result receiver isValue. self assert: result selector = #+. self assert: result arguments first isValue! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment4 super testComment4. self assert: result isMessage. self assert: result receiver isValue. self assert: result selector = #+. self assert: result arguments first isValue! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment5 super testComment5. self assert: result isMessage. self assert: result receiver isValue. self assert: result selector = #+. self assert: result arguments first isValue! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testComplexBlock1 super testComplexBlock1. self assert: result isBlock. self assert: result arguments size = 1. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testComplexBlock2 super testComplexBlock2. self assert: result isBlock. self assert: result arguments size = 1. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression1 super testKeywordExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result selector = #to:. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression2 super testKeywordExpression2. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #to:by:. self assert: result arguments size = 2. self assert: result arguments first isLiteral. self assert: result arguments first value = 2. self assert: result arguments second isLiteral. self assert: result arguments second value = 3! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression3 super testKeywordExpression3. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #to:by:do:. self assert: result arguments size = 3. self assert: result arguments first isLiteral. self assert: result arguments first value = 2. self assert: result arguments second isLiteral. self assert: result arguments second value = 3. self assert: result arguments third isLiteral. self assert: result arguments third value = 4! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod1 super testKeywordMethod1. self assert: result isMethod. self assert: result selector = #to:. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod2 super testKeywordMethod2. self assert: result isMethod. self assert: result selector = #to:do:. self assert: result arguments size = 2. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod3 super testKeywordMethod3. self assert: result isMethod. self assert: result selector = #to:do:by:. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod4 super testKeywordMethod4. self assert: result isMethod. self assert: result selector = #to:do:by:. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod1 super testMethod1. self assert: result isMethod. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1. self assert: result body statements first isReturn. self assert: result body statements first value isMessage. self assert: result body statements first value receiver isLiteral. self assert: result body statements first value selector = #-. self assert: result body statements first value arguments size = 1. self assert: result body statements first value arguments first isVariable! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod2 super testMethod2. self assert: result isMethod. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1. self assert: result body statements first isReturn. self assert: result body statements first value isMessage. self assert: result body statements first value receiver isLiteral. self assert: result body statements first value selector = #-. self assert: result body statements first value arguments size = 1. self assert: result body statements first value arguments first isVariable! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod3 super testMethod3. self assert: result isMethod. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1. self assert: result body statements first isReturn. self assert: result body statements first value isMessage. self assert: result body statements first value receiver isLiteral. self assert: result body statements first value selector = #-. self assert: result body statements first value arguments size = 1. self assert: result body statements first value arguments first isVariable! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral1 super testNumberLiteral1. self assert: result isLiteral. self assert: result value = 0! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral10 super testNumberLiteral10. self assert: result isLiteral. self assert: result value = 10! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral11 super testNumberLiteral11. self assert: result isLiteral. self assert: result value = 511! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral12 super testNumberLiteral12. self assert: result isLiteral. self assert: result value = 175! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral13 super testNumberLiteral13. self assert: result isLiteral. self assert: result value = 202.9921875! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral14 super testNumberLiteral14. self assert: result isLiteral. self assert: result value floor = -9! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral2 super testNumberLiteral2. self assert: result isLiteral. self assert: result value = 0.1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral3 super testNumberLiteral3. self assert: result isLiteral. self assert: result value = 123! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral4 super testNumberLiteral4. self assert: result isLiteral. self assert: result value = 123.456! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral5 super testNumberLiteral5. self assert: result isLiteral. self assert: result value = 0! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral6 super testNumberLiteral6. self assert: result isLiteral. self assert: result value = -0.1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral7 super testNumberLiteral7. self assert: result isLiteral. self assert: result value = -123! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral8 super testNumberLiteral8. self assert: result isLiteral. self assert: result value = -123! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral9 super testNumberLiteral9. self assert: result isLiteral. self assert: result value = -123.456! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma1 super testPragma1. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma10 super testPragma10. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma11 super testPragma11. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma12 super testPragma12. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma13 super testPragma13. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma14 super testPragma14. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma15 super testPragma15. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma2 super testPragma2. self assert: result pragmas format: #('' '' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma3 super testPragma3. self assert: result pragmas format: #('' ). self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma4 super testPragma4. self assert: result pragmas format: #('' ). self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma5 super testPragma5. self assert: result pragmas format: #('' '' ). self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma6 super testPragma6. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma7 super testPragma7. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma8 super testPragma8. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma9 super testPragma9. self assert: result pragmas format: #('' ). self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testSequence1 super testSequence1. self assert: result isSequence. self assert: result temporaries size = 1. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result statements size = 2. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock1 super testSimpleBlock1. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock2 super testSimpleBlock2. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock3 super testSimpleBlock3. self assert: result isBlock. self assert: result arguments size = 1. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral1 super testSpecialLiteral1. self assert: result isLiteral. self assert: result value = true! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral2 super testSpecialLiteral2. self assert: result isLiteral. self assert: result value = false! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral3 super testSpecialLiteral3. self assert: result isLiteral. self assert: result value = nil! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock1 super testStatementBlock1. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock2 super testStatementBlock2. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock3 super testStatementBlock3. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries size = 2. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements1 super testStatements1. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 1. self assert: result statements first isLiteral. self assert: result statements first value = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements2 super testStatements2. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 2. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements3 super testStatements3. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 3. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2. self assert: result statements third isLiteral. self assert: result statements third value = 3! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements4 super testStatements4. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 3. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2. self assert: result statements third isLiteral. self assert: result statements third value = 3! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements5 super testStatements5. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 2. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral1 super testStringLiteral1. self assert: result isLiteral. self assert: result value = ''! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral2 super testStringLiteral2. self assert: result isLiteral. self assert: result value = 'ab'! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral3 super testStringLiteral3. self assert: result isLiteral. self assert: result value = 'ab''cd'! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral1 super testSymbolLiteral1. self assert: result isLiteral. self assert: result value = #foo! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral2 super testSymbolLiteral2. self assert: result isLiteral. self assert: result value = #+! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral3 super testSymbolLiteral3. self assert: result isLiteral. self assert: result value = #key:! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral4 super testSymbolLiteral4. self assert: result isLiteral. self assert: result value = #key:value:! ! !PPSmalltalkCompilerTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral5 super testSymbolLiteral5. self assert: result isLiteral. self assert: result value = #'testing-result'! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries1 super testTemporaries1. self assert: result isSequence. self assert: result temporaries size = 1. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries2 super testTemporaries2. self assert: result isSequence. self assert: result temporaries size = 2. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result temporaries second isVariable. self assert: result temporaries second name = 'b'. self assert: result statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries3 super testTemporaries3. self assert: result isSequence. self assert: result temporaries size = 3. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result temporaries second isVariable. self assert: result temporaries second name = 'b'. self assert: result temporaries third isVariable. self assert: result temporaries third name = 'c'. self assert: result statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryExpression1 super testUnaryExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #abs. self assert: result arguments isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryExpression2 super testUnaryExpression2. self assert: result isMessage. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver selector = #abs. self assert: result receiver arguments isEmpty. self assert: result selector = #negated. self assert: result arguments isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod1 super testUnaryMethod1. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod2 super testUnaryMethod2. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod3 super testUnaryMethod3. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod4 super testUnaryMethod4. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !PPSmalltalkCompilerTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod5 super testUnaryMethod5. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable1 super testVariable1. self assert: result isVariable. self assert: result name = 'trueBinding'! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable2 super testVariable2. self assert: result isVariable. self assert: result name = 'falseBinding'! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable3 super testVariable3. self assert: result isVariable. self assert: result name = 'nilly'! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable4 super testVariable4. self assert: result isVariable. self assert: result name = 'selfish'! ! !PPSmalltalkCompilerTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable5 super testVariable5. self assert: result isVariable. self assert: result name = 'supernanny'! ! !PPSmalltalkGrammarTests methodsFor: 'accessing' stamp: 'lr 9/27/2009 12:42'! parserClass ^ PPSmalltalkGrammar! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock1 self parse: '[ :a | ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock2 self parse: '[ :a :b | ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testArgumentsBlock3 self parse: '[ :a :b :c | ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral1 self parse: '#()' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral10 self parse: '#((1 2) #(1 2 3))' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral11 self parse: '#([1 2] #[1 2 3])' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral2 self parse: '#(1)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral3 self parse: '#(1 2)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral4 self parse: '#(true false nil)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral5 self parse: '#($a)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral6 self parse: '#(1.2)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral7 self parse: '#(size #at: at:put: #''=='')' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testArrayLiteral8 self parse: '#(''baz'')' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'TestRunner 10/23/2009 16:52'! testArrayLiteral9 self parse: '#((1) 2)' rule: #arrayLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment1 self parse: '1' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment2 self parse: 'a := 1' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment3 self parse: 'a := b := 1' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment4 self parse: 'a _ 1' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testAssignment5 self parse: 'a _ b _ 1' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryExpression1 self parse: '1 + 2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryExpression2 self parse: '1 + 2 + 3' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod1 self parse: '+ a' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod2 self parse: '+ a | b |' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod3 self parse: '+ a b' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testBinaryMethod4 self parse: '+ a | b | c' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral1 self parse: '#[]' rule: #byteLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral2 self parse: '#[0]' rule: #byteLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral3 self parse: '#[255]' rule: #byteLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral4 self parse: '#[ 1 2 ]' rule: #byteLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testByteLiteral5 self parse: '#[ 2r1010 8r77 16rFF ]' rule: #byteLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression1 self parse: '1 abs; negated' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression2 self parse: '1 abs negated; raisedTo: 12; negated' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testCascadeExpression3 self parse: '1 + 2; - 3' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral1 self parse: '$a' rule: #charLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral2 self parse: '$ ' rule: #charLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testCharLiteral3 self parse: '$$' rule: #charLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment1 self parse: '1"one"+2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment2 self parse: '1 "one" +2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment3 self parse: '1"one"+"two"2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment4 self parse: '1"one""two"+2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testComment5 self parse: '1"one" "two"+2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testComplexBlock1 self parse: '[ :a | | b | c ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testComplexBlock2 self parse: '[:a||b|c]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression1 self parse: '1 to: 2' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression2 self parse: '1 to: 2 by: 3' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordExpression3 self parse: '1 to: 2 by: 3 do: 4' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod1 self parse: 'to: a' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod2 self parse: 'to: a do: b | c |' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod3 self parse: 'to: a do: b by: c d' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testKeywordMethod4 self parse: 'to: a do: b by: c | d | e' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod1 self parse: 'negated ^ 0 - self' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod2 "Spaces at the beginning of the method." self parse: ' negated ^ 0 - self' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testMethod3 "Spaces at the end of the method." self parse: ' negated ^ 0 - self ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral1 self parse: '0' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral10 self parse: '10r10' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral11 self parse: '8r777' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral12 self parse: '16rAF' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral13 self parse: '16rCA.FE' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral14 self parse: '3r-22.2' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral2 self parse: '0.1' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral3 self parse: '123' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral4 self parse: '123.456' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral5 self parse: '-0' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral6 self parse: '-0.1' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral7 self parse: '-123' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral8 self parse: '-123' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testNumberLiteral9 self parse: '-123.456' rule: #numberLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma1 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma10 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma11 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma12 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma13 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma14 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma15 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma2 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma3 self parse: 'method | a | ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma4 self parse: 'method | a |' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma5 self parse: 'method | a | ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma6 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma7 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma8 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-pragmas' stamp: 'lr 9/27/2009 12:42'! testPragma9 self parse: 'method ' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testSequence1 self parse: '| a | 1 . 2' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock1 self parse: '[ ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock2 self parse: '[ nil ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testSimpleBlock3 self parse: '[ :a ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral1 self parse: 'true' rule: #trueLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral2 self parse: 'false' rule: #falseLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSpecialLiteral3 self parse: 'nil' rule: #nilLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock1 self parse: '[ nil ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock2 self parse: '[ | a | nil ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 9/27/2009 12:42'! testStatementBlock3 self parse: '[ | a b | nil ]' rule: #block! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements1 self parse: '1' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements2 self parse: '1 . 2' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements3 self parse: '1 . 2 . 3' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements4 self parse: '1 . 2 . 3 .' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testStatements5 self parse: '1 . . 2' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral1 self parse: '''''' rule: #stringLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral2 self parse: '''ab''' rule: #stringLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testStringLiteral3 self parse: '''ab''''cd''' rule: #stringLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral1 self parse: '#foo' rule: #symbolLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral2 self parse: '#+' rule: #symbolLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral3 self parse: '#key:' rule: #symbolLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral4 self parse: '#key:value:' rule: #symbolLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing-literals' stamp: 'lr 9/27/2009 12:42'! testSymbolLiteral5 self parse: '#''testing-result''' rule: #symbolLiteral! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries1 self parse: '| a |' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries2 self parse: '| a b |' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testTemporaries3 self parse: '| a b c |' rule: #sequence! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryExpression1 self parse: '1 abs' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryExpression2 self parse: '1 abs negated' rule: #expression! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod1 self parse: 'abs' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod2 self parse: 'abs | a |' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod3 self parse: 'abs a' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod4 self parse: 'abs | a | b' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing-messages' stamp: 'lr 9/27/2009 12:42'! testUnaryMethod5 self parse: 'abs | a |' rule: #method! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable1 self parse: 'trueBinding' rule: #primary! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable2 self parse: 'falseBinding' rule: #primary! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable3 self parse: 'nilly' rule: #primary! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable4 self parse: 'selfish' rule: #primary! ! !PPSmalltalkGrammarTests methodsFor: 'testing' stamp: 'lr 9/27/2009 12:42'! testVariable5 self parse: 'supernanny' rule: #primary! !