compiler/TSemanticAnalyserTests.st
changeset 13 97090c2baa33
parent 9 569bf5707c7e
child 16 17a2d1d9f205
--- 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> $'
+! !
+