--- a/compiler/TSemanticAnalyserTests.st Fri Sep 18 06:20:53 2015 +0100
+++ b/compiler/TSemanticAnalyserTests.st Sun Sep 20 12:01:42 2015 +0100
@@ -3,21 +3,107 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#TSemanticAnalyserTests
- instanceVariableNames:''
+ instanceVariableNames:'environment'
classVariableNames:''
poolDictionaries:''
category:'Languages-Tea-Compiler-Internals-Tests'
!
+
+!TSemanticAnalyserTests methodsFor:'running'!
+
+setUp
+ super setUp.
+ environment := TEnvironment new
+
+ "Modified: / 19-09-2015 / 05:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDown
+ environment := nil.
+ super tearDown.
+
+ "Modified: / 19-09-2015 / 05:54:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!TSemanticAnalyserTests methodsFor:'tests'!
-test_01
+test_bindings_01
+ | class method tree |
+
+ class := TClassDefinition newClass name: 'tSIntegerW'.
+ method := TMethodDefinition class: class selector: 'foo'.
+ method source: 'foo <^ tSIntegerW> | a <tSIntegerW> | ^ a + 1'.
+ tree := method parseTree.
- "Created: / 29-08-2015 / 14:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ TSemanticAnalyser runOn: tree inEnvironment: environment.
+
+ self assert: tree body temporaries first binding isLocalBinding.
+ self assert: tree body statements first"^ node" value receiver"a node" binding == tree body temporaries first binding.
+ self assert: tree body statements first"^ node" value arguments first"1 node" binding isConstantBinding.
+
+ "Created: / 19-09-2015 / 06:33:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-09-2015 / 18:14:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-test_special_form_01
+test_scopes_01
+ | class method tree |
+
+ class := TClassDefinition newClass name: 'TestClass'.
+ method := TMethodDefinition class: class selector: 'foo'.
+ method source: 'foo <^ TestClass> self do:[ :each <tSIntegerW> | each ]'.
+ tree := method parseTree.
+
+ TSemanticAnalyser runOn: tree inEnvironment: environment.
+
+ self assert: tree scope parent isNil.
+ self assert: tree scope node == tree.
+ self assert: tree scope children isEmptyOrNil.
+ self assert: tree scope variables size == 1"self".
+ self assert: tree body scope == tree scope.
+
+ self assert: tree body statements first arguments first scope parent isNil. "Not an inlined block"
+ self assert: tree body statements first arguments first scope node == tree body statements first arguments first.
+ self assert: tree body statements first arguments first scope children isEmptyOrNil.
+ self assert: tree body statements first arguments first scope variables size == 1"each".
+ self assert: tree body statements first arguments first scope variables anElement name = 'each'.
+
+ "Created: / 19-09-2015 / 05:53:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
- "Created: / 14-09-2015 / 12:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+test_scopes_02
+ | class method tree |
+
+ class := TClassDefinition newClass name: 'TestClass'.
+ method := TMethodDefinition class: class selector: 'foo'.
+ method source: 'foo <^ TestClass> true ifTrue:[ false ifTrue:[ ] ]'.
+ tree := method parseTree.
+
+ TSemanticAnalyser runOn: tree inEnvironment: environment.
+
+ self assert: tree scope parent isNil.
+ self assert: tree scope node == tree.
+ self assert: tree scope children size == 1"ifTrue: scope".
+ self assert: tree scope variables size == 1"self".
+ self assert: tree body scope == tree scope.
+
+ self assert: tree body statements first arguments first scope parent == tree scope.
+ self assert: tree body statements first arguments first scope node == tree body statements first arguments first.
+ self assert: tree body statements first arguments first scope children size == 1.
+ self assert: tree body statements first arguments first scope variables isEmpty.
+
+ self assert: tree body statements first arguments first "outer block"
+ body statements first arguments first "inner block" scope parent
+ ==
+ tree body statements first arguments first"outer block" scope.
+
+ "Created: / 19-09-2015 / 06:11:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!TSemanticAnalyserTests class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+