SystemOrganization addCategory: #'AST-Compiler'! RBProgramNodeVisitor subclass: #RBTranslator instanceVariableNames: 'compiler encoder node' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBTranslator class methodsFor: 'instance creation' stamp: 'lr 1/11/2010 11:14'! compiler: aCompiler encoder: anEncoder ^ self new compiler: aCompiler; encoder: anEncoder; yourself! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/15/2009 11:03'! acceptArrayNode: anArrayNode ^ BraceNode new elements: (anArrayNode statements collect: [ :each | self visitNode: each ]) sourceLocations: (anArrayNode statements collect: [ :each | each start ])! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/16/2009 20:08'! acceptAssignmentNode: anAssignmentNode | variable value assignment | assignment := AssignmentNode new variable: (self visitNode: anAssignmentNode variable) value: (self visitNode: anAssignmentNode value) from: self encoder sourceRange: anAssignmentNode sourceInterval. assignment variable nowHasDef. ^ assignment! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/17/2009 08:24'! acceptBlockNode: aBlockNode | block arguments temporaries statements | block := BlockNode new. arguments := aBlockNode arguments collect: [ :each | self encoder bindBlockArg: each name within: block ]. temporaries := aBlockNode body temporaries collect: [ :each | self encoder bindBlockTemp: each name within: block ]. statements := self visitNode: aBlockNode body. statements isEmpty ifTrue: [ statements addLast: (arguments isEmpty ifTrue: [ ParseNode classPool at: #NodeNil ] ifFalse: [ self encoder encodeVariable: arguments last name ]) ]. block arguments: arguments statements: statements returns: aBlockNode body lastIsReturn from: self encoder; temporaries: temporaries. block noteSourceRangeStart: aBlockNode start end: aBlockNode stop encoder: self encoder. arguments do: [ :variable | variable scope: -1 ]. temporaries do: [ :variable | variable scope: -1 ]. ^ block! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/17/2009 08:35'! acceptCascadeNode: aCascadeNode | recevier | ^ CascadeNode new receiver: (recevier := self visitNode: aCascadeNode receiver) messages: (aCascadeNode messages collect: [ :node | MessageNode new receiver: recevier selector: node selector arguments: (node arguments collect: [ :each | self visitNode: each ]) precedence: node selector precedence from: self encoder sourceRange: node sourceInterval; receiver: nil ])! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/15/2009 15:10'! acceptLiteralArrayNode: aRBLiteralArrayNode ^ self encoder encodeLiteral: aRBLiteralArrayNode value! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/16/2009 10:54'! acceptLiteralNode: aLiteralNode aLiteralNode value == nil ifTrue: [ ^ ParseNode classPool at: #NodeNil ]. aLiteralNode value == true ifTrue: [ ^ ParseNode classPool at: #NodeTrue ]. aLiteralNode value == false ifTrue: [ ^ ParseNode classPool at: #NodeFalse ]. ^ self encoder encodeLiteral: aLiteralNode value! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/16/2009 10:40'! acceptMessageNode: aMessageNode ^ MessageNode new receiver: (self visitNode: aMessageNode receiver) selector: aMessageNode selector arguments: (aMessageNode arguments collect: [ :each | self visitNode: each ]) precedence: aMessageNode selector precedence from: self encoder sourceRange: aMessageNode sourceInterval! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 1/11/2010 13:59'! acceptMethodNode: aMethodNode | method properties arguments temporaries pragmas statements block | self encoder selector: aMethodNode selector. method := self encoder methodNodeClass new. method sourceText: aMethodNode source. properties := AdditionalMethodState new. properties selector: aMethodNode selector. arguments := (aMethodNode selector = #DoItIn: and: [ aMethodNode arguments first name = self encoder doItInContextName ]) ifTrue: [ Array with: (self encoder encodeVariable: aMethodNode arguments first name) ] ifFalse: [ aMethodNode arguments collect: [ :each | (self encoder bindArg: each name) beMethodArg ] ]. temporaries := aMethodNode body temporaries collect: [ :each | self encoder bindTemp: each name ]. aMethodNode pragmas do: [ :each | properties := properties copyWith: (self visitNode: each ) ]. statements := self visitNode: aMethodNode body. statements isEmpty ifTrue: [ statements addLast: (self encoder encodeVariable: 'self') ]. block := BlockNode new. block arguments: Array new statements: statements returns: aMethodNode lastIsReturn from: self encoder. block returnSelfIfNoOther: self encoder. ^ method selector: aMethodNode selector arguments: arguments precedence: aMethodNode selector precedence temporaries: temporaries block: block encoder: self encoder primitive: aMethodNode primitiveNumber properties: properties! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/16/2009 10:36'! acceptPragmaNode: aPragmaNode | pragma name module | pragma := Pragma keyword: aPragmaNode selector arguments: (aPragmaNode arguments collect: [ :each | each value ]) asArray. (aPragmaNode isPrimitive and: [ pragma arguments first isString ]) ifTrue: [ name := pragma arguments at: 1. module := pragma arguments at: 2 ifAbsent: [ nil ]. self encoder litIndex: (Array with: (module ifNotNil: [ module asSymbol ]) with: name asSymbol with: 0 with: 0) ]. ^ pragma! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/15/2009 12:24'! acceptReturnNode: aReturnNode ^ ReturnNode new expr: (self visitNode: aReturnNode value) encoder: self encoder sourceRange: (aReturnNode start isNil ifFalse: [ aReturnNode sourceInterval ])! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/17/2009 08:24'! acceptSequenceNode: aSequenceNode ^ aSequenceNode statements collect: [ :each | self visitNode: each ]! ! !RBTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 1/11/2010 11:05'! acceptVariableNode: aVariableNode aVariableNode name = 'self' ifTrue: [ ^ ParseNode classPool at: #NodeSelf ]. aVariableNode name = 'super' ifTrue: [ ^ ParseNode classPool at: #NodeSuper ]. aVariableNode name = 'thisContext' ifTrue: [ ^ ParseNode classPool at: #NodeThisContext ]. ^ self encoder encodeVariable: aVariableNode name sourceRange: aVariableNode sourceInterval ifUnknown: [ self correctVariable: aVariableNode ]! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'! canDeclareClassVariable ^ self encoder classEncoding ~= UndefinedObject! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 1/11/2010 11:14'! compiler ^ compiler! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 1/11/2010 11:14'! compiler: aCompiler compiler := aCompiler! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 11:29'! correctVariable: aNode | action temp binding selection | (self encoder classEncoding instVarNames includes: aNode name) ifTrue: [ ^ InstanceVariableNode new name: aNode name index: (self encoder classEncoding allInstVarNames indexOf: aNode name) ]. "If we can't ask the user for correction, make it undeclared" self compiler interactive ifFalse: [ ^ self encoder undeclared: aNode name ]. "First check to see if the requestor knows anything about the variable" temp := aNode name first isLowercase. (temp and: [ (binding := self requestor bindingOf: aNode name) notNil ]) ifTrue: [ ^ self encoder global: binding name: aNode name ]. selection := self requestor selectionInterval. self requestor selectFrom: aNode start to: aNode stop; select. "Build the menu with alternatives" action := UndeclaredVariable signalFor: self name: aNode name inRange: aNode sourceInterval. action ifNil: [ ^ self compiler fail ]. self requestor deselect; selectInvisiblyFrom: selection first to: selection last. ^ action value! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'! declareClassVar: aString | symbol class | symbol := aString asSymbol. class := self encoder classEncoding theNonMetaClass. class addClassVarName: aString. ^ self encoder global: (class classPool associationAt: symbol) name: symbol! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:58'! declareGlobal: aString | name | name := aString asSymbol. ^ self encoder global: (self encoder environment at: name put: nil; associationAt: name) name: name! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'! declareInstVar: aString self encoder classEncoding addInstVarName: aString. ^ InstanceVariableNode new name: aString index: self encoder classEncoding instSize! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 15:52'! declareTempAndPaste: aString | sequenceNode | sequenceNode := node methodNode body. sequenceNode rightBar isNil ifTrue: [ self requestor correctFrom: sequenceNode start to: sequenceNode start - 1 with: '| ' , aString , ' |' , String cr , String tab ] ifFalse: [ self requestor correctFrom: sequenceNode rightBar to: sequenceNode rightBar - 1 with: aString , ' ' ]. ^ self encoder bindAndJuggle: aString! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:58'! defineClass: aString | name category definition | name := aString asSymbol. category := UIManager default request: 'Enter class category: ' initialAnswer: self encoder classEncoding theNonMetaClass category. category isEmptyOrNil ifTrue: [ category := 'Unknown' ]. definition := 'Object subclass: ' , name printString , ' instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ' , category printString. Compiler evaluate: definition. ^ self encoder global: (Smalltalk associationAt: name) name: name! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:54'! encoder ^ encoder! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:53'! encoder: anEncoder encoder := anEncoder! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 11:29'! possibleVariablesFor: aString ^ self encoder possibleVariablesFor: aString! ! !RBTranslator methodsFor: 'accessing-dynamic' stamp: 'lr 1/11/2010 11:25'! requestor ^ self compiler requestor! ! !RBTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:44'! substituteVariable: aString atInterval: anInterval self requestor correctFrom: anInterval first to: anInterval last with: aString. ^ self encoder encodeVariable: aString! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 1/11/2010 15:28'! visitNode: aNode | previous result | previous := node. result := super visitNode: (node := aNode). node := previous. ^ result! ! Object subclass: #RBCompiler instanceVariableNames: 'source requestor class category context failBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBCompiler methodsFor: 'compiling' stamp: 'lr 12/27/2009 17:06'! compile: aString in: aClass classified: aCategory notifying: aRequestor ifFail: aFailBlock self setSource: aString; setClass: aClass; setCategory: aCategory; setRequestor: aRequestor; setFailBlock: [ ^ aFailBlock value ]. ^ self translate: (self parse: true)! ! !RBCompiler methodsFor: 'compiling' stamp: 'lr 12/27/2009 16:02'! compile: aString in: aClass notifying: aRequestor ifFail: aFailBlock ^ self compile: aString in: aClass classified: nil notifying: aRequestor ifFail: aFailBlock ! ! !RBCompiler methodsFor: 'accessing' stamp: 'lr 2/14/2010 10:37'! decompilerClass ^ Decompiler! ! !RBCompiler methodsFor: 'private-configuration' stamp: 'lr 2/14/2010 10:39'! encoderClass "Answer the encoder to build the compiled method." ^ EncoderForV3PlusClosures! ! !RBCompiler methodsFor: 'evaluating' stamp: 'lr 12/27/2009 15:47'! evaluate: aString in: aContext to: aReceiver ^ self evaluate: aString in: aContext to: aReceiver notifying: nil ifFail: [ ^ #failedDoit ]! ! !RBCompiler methodsFor: 'evaluating' stamp: 'lr 12/27/2009 16:06'! evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock ^ self evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock logged: false! ! !RBCompiler methodsFor: 'evaluating' stamp: 'lr 12/27/2009 16:12'! evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock logged: aLogBoolean "Compiles the sourceStream into a parse tree, then generates code into a method. This method is then installed in the receiver's class so that it can be invoked. In other words, if receiver is not nil, then the text can refer to instance variables of that receiver (the Inspector uses this). If aContext is not nil, the text can refer to temporaries in that context (the Debugger uses this). If aRequestor is not nil, then it will receive a notify:at: message before the attempt to evaluate is aborted." | node method result | self setSource: aString; setContext: aContext; setRequestor: aRequestor; setFailBlock: [ ^ aFailBlock value ]. self setClass: (aContext isNil ifTrue: [ aReceiver ] ifFalse: [ aContext receiver ]) class. node := self translate: (self parse: false). method := node generate: #(0 0 0 0). self interactive ifTrue: [ method := method copyWithTempsFromMethodNode: node ]. result := aReceiver withArgs: (context isNil ifTrue: [ Array new ] ifFalse: [ Array with: context ]) executeMethod: method. aLogBoolean ifTrue: [ SystemChangeNotifier uniqueInstance evaluated: aString context: aContext ]. ^ result! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 1/11/2010 13:41'! fail ^ failBlock value! ! !RBCompiler methodsFor: 'formatting' stamp: 'lr 12/27/2009 16:00'! format: aString in: aClass notifying: aRequestor "Answer a string containing the original code, formatted nicely." | tree | self setSource: aString; setClass: aClass; setRequestor: aRequestor. tree := self parse: true. ^ tree formattedCode! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 12/27/2009 15:37'! interactive ^ UIManager default interactiveParserFor: requestor! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 12/27/2009 15:44'! notify: aString "Refer to the comment in Object|notify:." ^ self notify: aString at: 1! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 1/11/2010 13:40'! notify: aString at: anInteger requestor isNil ifTrue: [ SyntaxErrorNotification inClass: class category: category withCode: (source copyReplaceFrom: anInteger to: anInteger - 1 with: aString) doitFlag: false errorMessage: aString location: anInteger ] ifFalse: [ requestor notify: aString , ' ->' at: anInteger in: source ]. ^ self fail! ! !RBCompiler methodsFor: 'private' stamp: 'lr 2/14/2010 10:39'! parse: aPatternBoolean ^ aPatternBoolean ifTrue: [ self readerClass parseMethod: source onError: [ :msg :pos | self notify: msg at: pos ] ] ifFalse: [ self readerClass parseExpression: source onError: [ :msg :pos | self notify: msg at: pos ] ]! ! !RBCompiler methodsFor: 'accessing' stamp: 'lr 2/14/2010 10:37'! parserClass ^ Parser! ! !RBCompiler methodsFor: 'private-configuration' stamp: 'lr 2/14/2010 10:39'! readerClass "Answer the internal parser used to read the source code. This is not called parserClass because that name is already used by the public protocol." ^ RBParser! ! !RBCompiler methodsFor: 'accessing' stamp: 'lr 1/11/2010 11:26'! requestor ^ requestor! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:38'! setCategory: aSymbol category := aSymbol! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:41'! setClass: aClass class := aClass! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:41'! setContext: aContext context := aContext! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:43'! setFailBlock: aBlock failBlock := aBlock! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:37'! setRequestor: anObject requestor := anObject! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/27/2009 15:43'! setSource: aStringOrTextOrStream aStringOrTextOrStream isString ifTrue: [ ^ source := aStringOrTextOrStream ]. aStringOrTextOrStream isText ifTrue: [ ^ self setSource: aStringOrTextOrStream string ]. aStringOrTextOrStream isStream ifTrue: [ ^ self setSource: aStringOrTextOrStream upToEnd ]. self error: aStringOrTextOrStream printString , ' invalid source'! ! !RBCompiler methodsFor: 'private' stamp: 'lr 2/14/2010 09:18'! translate: aProgramNode | encoder | encoder := self encoderClass new. encoder init: class context: context notifying: requestor. aProgramNode isMethod ifFalse: [ aProgramNode methodNode addReturn. context isNil ifTrue: [ aProgramNode methodNode renameSelector: #DoIt andArguments: #() ] ifFalse: [ aProgramNode methodNode renameSelector: #DoItIn: andArguments: (Array with: (RBVariableNode named: encoder doItInContextName)) ] ]. ^ (RBTranslator compiler: self encoder: encoder) visitNode: aProgramNode methodNode! ! Object subclass: #RBCompilerDispatcher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! RBCompilerDispatcher class instanceVariableNames: 'current'! RBCompilerDispatcher class instanceVariableNames: 'current'! !RBCompilerDispatcher class methodsFor: 'accessing' stamp: 'lr 2/12/2010 20:10'! current "Answer the current compiler class." ^ current! ! !RBCompilerDispatcher class methodsFor: 'accessing' stamp: 'lr 2/12/2010 19:53'! current: aCompilerClass "Set the current compiler class." current := aCompilerClass! ! !RBCompilerDispatcher class methodsFor: 'initialization' stamp: 'lr 2/12/2010 20:14'! initialize self current: RBCompiler. self initializePreferences! ! !RBCompilerDispatcher class methodsFor: 'initialization' stamp: 'lr 2/12/2010 20:12'! initializePreferences Preferences addBooleanPreference: #enableCustomCompiler category: #compiler default: false balloonHelp: 'If enabled a custom compiler as defined by RBCompilerDispatcher will be used system-wide.'! ! !RBCompilerDispatcher class methodsFor: 'instance creation' stamp: 'lr 2/12/2010 21:54'! new ^ self current new! ! !RBCompilerDispatcher methodsFor: 'accessing' stamp: 'lr 2/12/2010 19:52'! readme "I am a generic class dispatching to to the right compiler instance. I am not supposed to be instantiated, but instead instantiate the responsible compiler."! ! Object subclass: #RBCompilerMock instanceVariableNames: 'x t1' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBCompilerMock class methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:57'! compilerClass ^ RBCompiler! ! !RBCompilerMock class methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:57'! evaluatorClass ^ RBCompiler! ! !Behavior methodsFor: '*ast-compiler-override' stamp: 'lr 2/12/2010 20:14'! compilerClass "Answer the compiler class responsible for compiling the methods of this class." | enabled | enabled := Preferences valueOfPreference: #enableCustomCompiler ifAbsent: [ ^ Compiler ]. ^ enabled ifTrue: [ RBCompilerDispatcher ] ifFalse: [ Compiler ]! ! !RBMethodNode methodsFor: '*ast-compiler' stamp: 'lr 12/17/2009 08:21'! compile: aCompilationContext "Compiles the receiving AST in aCompilation context."! ! !RBMethodNode methodsFor: '*ast-compiler' stamp: 'lr 12/17/2009 08:22'! evaluate: anEvaluationContext "Evaluates the receiving AST in anEvaluationContext."! ! !RBMethodNode methodsFor: '*ast-compiler-accessing' stamp: 'lr 12/17/2009 08:27'! primitiveNumber | primitive | primitive := self pragmas detect: [ :each | each isPrimitive ] ifNone: [ ^ 0 ]. ^ primitive arguments first value isNumber ifTrue: [ primitive arguments first value ] ifFalse: [ 117 ]! ! TestCase subclass: #RBCompilerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/16/2009 11:05'! assertClass: aClass aClass selectors asSortedCollection do: [ :each | self assertClass: aClass selector: each ] displayingProgress: aClass name! ! !RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/27/2009 16:53'! assertClass: aClass selector: aSelector "Assert that aClass >> #aSelector compiles to identical bytecode as currently installed. Skip traits methods and skipt the float class due to bugs in Pharo." | method | (aClass includesLocalSelector: aSelector) ifFalse: [ ^ self ]. (aClass = Float class or: [ aClass traits notEmpty ]) ifTrue: [ ^ self ]. method := self compiler compile: (aClass sourceCodeAt: aSelector) in: aClass notifying: nil ifFail: nil. self assert: (aClass compiledMethodAt: aSelector) = method generate description: aClass name , '>>#' , aSelector resumable: true! ! !RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/15/2009 15:25'! assertImage "self new assertImage" Smalltalk allClasses do: [ :class | self assertClass: class ] displayingProgress: 'Testing all Image' ! ! !RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:54'! compiler ^ self compilerClass new! ! !RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/15/2009 12:23'! compilerClass ^ RBCompiler! ! !RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:59'! mock ^ self mockClass new! ! !RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:59'! mockClass ^ RBCompilerMock! ! !RBCompilerTest methodsFor: 'running' stamp: 'lr 2/12/2010 19:39'! runCase SystemChangeNotifier uniqueInstance doSilently: [ super runCase ]! ! !RBCompilerTest methodsFor: 'running' stamp: 'lr 12/27/2009 17:00'! tearDown super tearDown. self mockClass selectors do: [ :each | self mockClass removeSelector: each ]! ! !RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/15/2009 15:22'! testBoolean Boolean withAllSubclasses do: [ :each | self assertClass: each ]! ! !RBCompilerTest methodsFor: 'testing' stamp: 'lr 2/12/2010 19:40'! testCollection Collection withAllSubclasses do: [ :each | self assertClass: each ]! ! !RBCompilerTest methodsFor: 'testing-compiling' stamp: 'lr 12/27/2009 17:02'! testCompileAccessors self mockClass compile: 'x ^ x'. self mockClass compile: 'x: a x := a'. self assert: (self mock x: 2; x) = 2! ! !RBCompilerTest methodsFor: 'testing-compiling' stamp: 'lr 12/27/2009 17:05'! testCompileConstant self mockClass compile: 'first ^ 1'. self mockClass compile: 'second ^ self first'. self mockClass compile: 'third ^ #third'. self assert: (self mock first) = 1. self assert: (self mock second) = 1. self assert: (self mock third) = 'third' ! ! !RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:48'! testEvaluate self assert: (self compiler evaluate: '2 + 3' in: nil to: nil) = 5. self assert: (self compiler evaluate: '^ 2 + 3' in: nil to: nil) = 5! ! !RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:47'! testEvaluateContext | point | point := 2 @ 3. self assert: (self compiler evaluate: 'point' in: thisContext to: nil) = point. self assert: (self compiler evaluate: 'point x' in: thisContext to: nil) = point x. self assert: (self compiler evaluate: 'point y' in: thisContext to: nil) = point y! ! !RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:47'! testEvaluateReceiver | point | point := 2 @ 3. self assert: (self compiler evaluate: 'self' in: nil to: nil) isNil. self assert: (self compiler evaluate: 'self' in: nil to: point) = point. self assert: (self compiler evaluate: 'x' in: nil to: point) = point x. self assert: (self compiler evaluate: 'self x' in: nil to: point) = point x. self assert: (self compiler evaluate: 'y' in: nil to: point) = point y. self assert: (self compiler evaluate: 'self y' in: nil to: point) = point y ! ! !RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/27/2009 16:48'! testNumber Number withAllSubclasses do: [ :each | self assertClass: each ]! ! !RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/27/2009 16:54'! testObject self assertClass: Object. self assertClass: ProtoObject! ! RBCompilerDispatcher initialize!