|
@@ -1,73 +1,20 @@
|
|
|
Smalltalk createPackage: 'Compiler-Tests'!
|
|
|
-TestCase subclass: #ASTParsingTest
|
|
|
- slots: {}
|
|
|
- package: 'Compiler-Tests'!
|
|
|
-
|
|
|
-!ASTParsingTest methodsFor: 'parsing'!
|
|
|
-
|
|
|
-parse: aString forClass: aClass
|
|
|
- ^ Compiler new
|
|
|
- ast: aString
|
|
|
- forClass: aClass
|
|
|
- protocol: 'test'
|
|
|
-! !
|
|
|
-
|
|
|
-ASTParsingTest subclass: #ASTCompilingTest
|
|
|
+TestCase subclass: #ASTMethodRunningTest
|
|
|
slots: {#receiver}
|
|
|
package: 'Compiler-Tests'!
|
|
|
|
|
|
-!ASTCompilingTest methodsFor: 'accessing'!
|
|
|
-
|
|
|
-codeGeneratorClass
|
|
|
- self subclassResponsibility
|
|
|
-! !
|
|
|
-
|
|
|
-!ASTCompilingTest methodsFor: 'compiling'!
|
|
|
-
|
|
|
-install: aString forClass: aClass
|
|
|
- ^ self compiler
|
|
|
- install: aString
|
|
|
- forClass: aClass
|
|
|
- protocol: 'tests'
|
|
|
-! !
|
|
|
-
|
|
|
-!ASTCompilingTest methodsFor: 'factory'!
|
|
|
+!ASTMethodRunningTest methodsFor: 'accessing'!
|
|
|
|
|
|
-compiler
|
|
|
- ^ Compiler new
|
|
|
- codeGeneratorClass: self codeGeneratorClass;
|
|
|
- yourself
|
|
|
+receiver
|
|
|
+ ^ receiver
|
|
|
! !
|
|
|
|
|
|
-!ASTCompilingTest methodsFor: 'initialization'!
|
|
|
+!ASTMethodRunningTest methodsFor: 'initialization'!
|
|
|
|
|
|
setUp
|
|
|
receiver := DoIt new
|
|
|
-!
|
|
|
-
|
|
|
-tearDown
|
|
|
- "receiver := nil"
|
|
|
! !
|
|
|
|
|
|
-!ASTCompilingTest methodsFor: 'testing'!
|
|
|
-
|
|
|
-while: aString inClass: aClass should: aBlock
|
|
|
- | method |
|
|
|
-
|
|
|
- [
|
|
|
- method := self install: aString forClass: aClass.
|
|
|
- aBlock value: method ]
|
|
|
- ensure: [ method ifNotNil: [ aClass removeCompiledMethod: method ] ]
|
|
|
-!
|
|
|
-
|
|
|
-while: aString should: aBlock
|
|
|
- self while: aString inClass: receiver class should: aBlock
|
|
|
-! !
|
|
|
-
|
|
|
-ASTCompilingTest subclass: #ASTMethodRunningTest
|
|
|
- slots: {}
|
|
|
- package: 'Compiler-Tests'!
|
|
|
-
|
|
|
!ASTMethodRunningTest methodsFor: 'running'!
|
|
|
|
|
|
actOn: aMethod in: aClass
|
|
@@ -99,8 +46,8 @@ should: aString return: anObject
|
|
|
!
|
|
|
|
|
|
while: aString inClass: aClass should: aBlock
|
|
|
- super
|
|
|
- while: aString
|
|
|
+ self
|
|
|
+ whileExamining: aString
|
|
|
inClass: aClass
|
|
|
should: [ :method | aBlock value: [ self actOn: method in: aClass ] ]
|
|
|
! !
|
|
@@ -535,69 +482,7 @@ codeGeneratorClass
|
|
|
^ InliningCodeGenerator
|
|
|
! !
|
|
|
|
|
|
-ASTCompilingTest subclass: #CodeGeneratorInstallTest
|
|
|
- slots: {}
|
|
|
- package: 'Compiler-Tests'!
|
|
|
-
|
|
|
-!CodeGeneratorInstallTest methodsFor: 'accessing'!
|
|
|
-
|
|
|
-codeGeneratorClass
|
|
|
- ^ CodeGenerator
|
|
|
-! !
|
|
|
-
|
|
|
-!CodeGeneratorInstallTest methodsFor: 'testing'!
|
|
|
-
|
|
|
-shouldntInstall: aString
|
|
|
- | method |
|
|
|
-
|
|
|
- [ self
|
|
|
- should: [ method := self install: aString forClass: receiver class ]
|
|
|
- raise: ParseError ]
|
|
|
- ensure: [ method ifNotNil: [ receiver class removeCompiledMethod: method ] ]
|
|
|
-! !
|
|
|
-
|
|
|
-!CodeGeneratorInstallTest methodsFor: 'tests'!
|
|
|
-
|
|
|
-testMistypedPragmaJSStatement
|
|
|
- self shouldntInstall: 'foo < inlineJS: ''return ''foo'''' >'
|
|
|
-!
|
|
|
-
|
|
|
-testNiladicJSOverride
|
|
|
- receiver := ObjectMock new.
|
|
|
- receiver foo: 4.
|
|
|
- self while: 'baz <jsOverride: #baz> ^ (foo := foo + 3)' should: [
|
|
|
- self assert: receiver baz equals: 7.
|
|
|
- self assert: (receiver basicPerform: #baz) equals: 10.
|
|
|
- self assert: receiver baz equals: 13.
|
|
|
- self assert: receiver foo equals: 13 ]
|
|
|
-!
|
|
|
-
|
|
|
-testNiladicJSOverrideDifferentNames
|
|
|
- receiver := ObjectMock new.
|
|
|
- receiver foo: 4.
|
|
|
- self while: 'quux <jsOverride: #mux> ^ (foo := foo + 3)' should: [
|
|
|
- self should: [ receiver mux ] raise: MessageNotUnderstood.
|
|
|
- self assert: (receiver basicPerform: #mux) equals: 7.
|
|
|
- self assert: receiver quux equals: 10.
|
|
|
- self should: [ receiver basicPerform: #quux ] raise: Error.
|
|
|
- self assert: receiver foo equals: 10 ]
|
|
|
-!
|
|
|
-
|
|
|
-testPragmaInBlock
|
|
|
- self shouldntInstall: 'foo ^ [ < fooBar > 4 ] value'
|
|
|
-! !
|
|
|
-
|
|
|
-CodeGeneratorInstallTest subclass: #InliningCodeGeneratorInstallTest
|
|
|
- slots: {}
|
|
|
- package: 'Compiler-Tests'!
|
|
|
-
|
|
|
-!InliningCodeGeneratorInstallTest methodsFor: 'accessing'!
|
|
|
-
|
|
|
-codeGeneratorClass
|
|
|
- ^ InliningCodeGenerator
|
|
|
-! !
|
|
|
-
|
|
|
-ASTParsingTest subclass: #ASTPCNodeVisitorTest
|
|
|
+TestCase subclass: #ASTPCNodeVisitorTest
|
|
|
slots: {}
|
|
|
package: 'Compiler-Tests'!
|
|
|
|
|
@@ -668,7 +553,7 @@ testNoMessageSend
|
|
|
currentNode) isNil
|
|
|
! !
|
|
|
|
|
|
-ASTParsingTest subclass: #ASTPositionTest
|
|
|
+TestCase subclass: #ASTPositionTest
|
|
|
slots: {}
|
|
|
package: 'Compiler-Tests'!
|
|
|
|
|
@@ -693,6 +578,72 @@ testNodeAtPosition
|
|
|
self assert: (node navigationNodeAt: 2@8 ifAbsent: [ nil ]) selector equals: 'foo'
|
|
|
! !
|
|
|
|
|
|
+TestCase subclass: #CodeGeneratorInstallTest
|
|
|
+ slots: {#receiver}
|
|
|
+ package: 'Compiler-Tests'!
|
|
|
+
|
|
|
+!CodeGeneratorInstallTest methodsFor: 'accessing'!
|
|
|
+
|
|
|
+codeGeneratorClass
|
|
|
+ ^ CodeGenerator
|
|
|
+!
|
|
|
+
|
|
|
+receiver
|
|
|
+ ^ receiver
|
|
|
+! !
|
|
|
+
|
|
|
+!CodeGeneratorInstallTest methodsFor: 'testing'!
|
|
|
+
|
|
|
+shouldntInstall: aString
|
|
|
+ | method |
|
|
|
+
|
|
|
+ [ self
|
|
|
+ should: [ method := self install: aString forClass: receiver class ]
|
|
|
+ raise: ParseError ]
|
|
|
+ ensure: [ method ifNotNil: [ receiver class removeCompiledMethod: method ] ]
|
|
|
+! !
|
|
|
+
|
|
|
+!CodeGeneratorInstallTest methodsFor: 'tests'!
|
|
|
+
|
|
|
+testMistypedPragmaJSStatement
|
|
|
+ self shouldntInstall: 'foo < inlineJS: ''return ''foo'''' >'
|
|
|
+!
|
|
|
+
|
|
|
+testNiladicJSOverride
|
|
|
+ receiver := ObjectMock new.
|
|
|
+ receiver foo: 4.
|
|
|
+ self while: 'baz <jsOverride: #baz> ^ (foo := foo + 3)' should: [
|
|
|
+ self assert: receiver baz equals: 7.
|
|
|
+ self assert: (receiver basicPerform: #baz) equals: 10.
|
|
|
+ self assert: receiver baz equals: 13.
|
|
|
+ self assert: receiver foo equals: 13 ]
|
|
|
+!
|
|
|
+
|
|
|
+testNiladicJSOverrideDifferentNames
|
|
|
+ receiver := ObjectMock new.
|
|
|
+ receiver foo: 4.
|
|
|
+ self while: 'quux <jsOverride: #mux> ^ (foo := foo + 3)' should: [
|
|
|
+ self should: [ receiver mux ] raise: MessageNotUnderstood.
|
|
|
+ self assert: (receiver basicPerform: #mux) equals: 7.
|
|
|
+ self assert: receiver quux equals: 10.
|
|
|
+ self should: [ receiver basicPerform: #quux ] raise: Error.
|
|
|
+ self assert: receiver foo equals: 10 ]
|
|
|
+!
|
|
|
+
|
|
|
+testPragmaInBlock
|
|
|
+ self shouldntInstall: 'foo ^ [ < fooBar > 4 ] value'
|
|
|
+! !
|
|
|
+
|
|
|
+CodeGeneratorInstallTest subclass: #InliningCodeGeneratorInstallTest
|
|
|
+ slots: {}
|
|
|
+ package: 'Compiler-Tests'!
|
|
|
+
|
|
|
+!InliningCodeGeneratorInstallTest methodsFor: 'accessing'!
|
|
|
+
|
|
|
+codeGeneratorClass
|
|
|
+ ^ InliningCodeGenerator
|
|
|
+! !
|
|
|
+
|
|
|
TestCase subclass: #ScopeVarTest
|
|
|
slots: {}
|
|
|
package: 'Compiler-Tests'!
|
|
@@ -914,3 +865,63 @@ testContextVariables
|
|
|
self shouldnt: [ analyzer visit: ast ] raise: UnknownVariableError
|
|
|
! !
|
|
|
|
|
|
+Trait named: #TASTCompilingTest
|
|
|
+ package: 'Compiler-Tests'!
|
|
|
+
|
|
|
+!TASTCompilingTest methodsFor: 'accessing'!
|
|
|
+
|
|
|
+codeGeneratorClass
|
|
|
+ self subclassResponsibility
|
|
|
+! !
|
|
|
+
|
|
|
+!TASTCompilingTest methodsFor: 'compiling'!
|
|
|
+
|
|
|
+install: aString forClass: aClass
|
|
|
+ ^ self compiler
|
|
|
+ install: aString
|
|
|
+ forClass: aClass
|
|
|
+ protocol: 'tests'
|
|
|
+! !
|
|
|
+
|
|
|
+!TASTCompilingTest methodsFor: 'factory'!
|
|
|
+
|
|
|
+compiler
|
|
|
+ ^ Compiler new
|
|
|
+ codeGeneratorClass: self codeGeneratorClass;
|
|
|
+ yourself
|
|
|
+! !
|
|
|
+
|
|
|
+!TASTCompilingTest methodsFor: 'testing'!
|
|
|
+
|
|
|
+while: aString inClass: aClass should: aBlock
|
|
|
+ | method |
|
|
|
+
|
|
|
+ [
|
|
|
+ method := self install: aString forClass: aClass.
|
|
|
+ aBlock value: method ]
|
|
|
+ ensure: [ method ifNotNil: [ aClass removeCompiledMethod: method ] ]
|
|
|
+!
|
|
|
+
|
|
|
+while: aString should: aBlock
|
|
|
+ self while: aString inClass: self receiver class should: aBlock
|
|
|
+! !
|
|
|
+
|
|
|
+Trait named: #TASTParsingTest
|
|
|
+ package: 'Compiler-Tests'!
|
|
|
+
|
|
|
+!TASTParsingTest methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aString forClass: aClass
|
|
|
+ ^ Compiler new
|
|
|
+ ast: aString
|
|
|
+ forClass: aClass
|
|
|
+ protocol: 'test'
|
|
|
+! !
|
|
|
+
|
|
|
+TASTCompilingTest setTraitComposition: {TASTParsingTest} asTraitComposition!
|
|
|
+ASTMethodRunningTest setTraitComposition: {TASTCompilingTest @ {#whileExamining:inClass:should: -> #while:inClass:should:}} asTraitComposition!
|
|
|
+ASTPCNodeVisitorTest setTraitComposition: {TASTParsingTest} asTraitComposition!
|
|
|
+ASTPositionTest setTraitComposition: {TASTParsingTest} asTraitComposition!
|
|
|
+CodeGeneratorInstallTest setTraitComposition: {TASTCompilingTest} asTraitComposition!
|
|
|
+! !
|
|
|
+
|