1 "{ Package: 'jv:tea/compiler' }" |
1 "{ Package: 'jv:tea/compiler' }" |
2 |
2 |
3 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
4 |
4 |
5 TestCase subclass:#TSemanticAnalyserTests |
5 TestCase subclass:#TSemanticAnalyserTests |
6 instanceVariableNames:'' |
6 instanceVariableNames:'environment' |
7 classVariableNames:'' |
7 classVariableNames:'' |
8 poolDictionaries:'' |
8 poolDictionaries:'' |
9 category:'Languages-Tea-Compiler-Internals-Tests' |
9 category:'Languages-Tea-Compiler-Internals-Tests' |
10 ! |
10 ! |
11 |
11 |
|
12 |
|
13 !TSemanticAnalyserTests methodsFor:'running'! |
|
14 |
|
15 setUp |
|
16 super setUp. |
|
17 environment := TEnvironment new |
|
18 |
|
19 "Modified: / 19-09-2015 / 05:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
20 ! |
|
21 |
|
22 tearDown |
|
23 environment := nil. |
|
24 super tearDown. |
|
25 |
|
26 "Modified: / 19-09-2015 / 05:54:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
27 ! ! |
|
28 |
12 !TSemanticAnalyserTests methodsFor:'tests'! |
29 !TSemanticAnalyserTests methodsFor:'tests'! |
13 |
30 |
14 test_01 |
31 test_bindings_01 |
|
32 | class method tree | |
15 |
33 |
16 "Created: / 29-08-2015 / 14:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
34 class := TClassDefinition newClass name: 'tSIntegerW'. |
|
35 method := TMethodDefinition class: class selector: 'foo'. |
|
36 method source: 'foo <^ tSIntegerW> | a <tSIntegerW> | ^ a + 1'. |
|
37 tree := method parseTree. |
|
38 |
|
39 TSemanticAnalyser runOn: tree inEnvironment: environment. |
|
40 |
|
41 self assert: tree body temporaries first binding isLocalBinding. |
|
42 self assert: tree body statements first"^ node" value receiver"a node" binding == tree body temporaries first binding. |
|
43 self assert: tree body statements first"^ node" value arguments first"1 node" binding isConstantBinding. |
|
44 |
|
45 "Created: / 19-09-2015 / 06:33:29 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
46 "Modified: / 19-09-2015 / 18:14:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
17 ! |
47 ! |
18 |
48 |
19 test_special_form_01 |
49 test_scopes_01 |
|
50 | class method tree | |
20 |
51 |
21 "Created: / 14-09-2015 / 12:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
52 class := TClassDefinition newClass name: 'TestClass'. |
|
53 method := TMethodDefinition class: class selector: 'foo'. |
|
54 method source: 'foo <^ TestClass> self do:[ :each <tSIntegerW> | each ]'. |
|
55 tree := method parseTree. |
|
56 |
|
57 TSemanticAnalyser runOn: tree inEnvironment: environment. |
|
58 |
|
59 self assert: tree scope parent isNil. |
|
60 self assert: tree scope node == tree. |
|
61 self assert: tree scope children isEmptyOrNil. |
|
62 self assert: tree scope variables size == 1"self". |
|
63 self assert: tree body scope == tree scope. |
|
64 |
|
65 self assert: tree body statements first arguments first scope parent isNil. "Not an inlined block" |
|
66 self assert: tree body statements first arguments first scope node == tree body statements first arguments first. |
|
67 self assert: tree body statements first arguments first scope children isEmptyOrNil. |
|
68 self assert: tree body statements first arguments first scope variables size == 1"each". |
|
69 self assert: tree body statements first arguments first scope variables anElement name = 'each'. |
|
70 |
|
71 "Created: / 19-09-2015 / 05:53:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
72 ! |
|
73 |
|
74 test_scopes_02 |
|
75 | class method tree | |
|
76 |
|
77 class := TClassDefinition newClass name: 'TestClass'. |
|
78 method := TMethodDefinition class: class selector: 'foo'. |
|
79 method source: 'foo <^ TestClass> true ifTrue:[ false ifTrue:[ ] ]'. |
|
80 tree := method parseTree. |
|
81 |
|
82 TSemanticAnalyser runOn: tree inEnvironment: environment. |
|
83 |
|
84 self assert: tree scope parent isNil. |
|
85 self assert: tree scope node == tree. |
|
86 self assert: tree scope children size == 1"ifTrue: scope". |
|
87 self assert: tree scope variables size == 1"self". |
|
88 self assert: tree body scope == tree scope. |
|
89 |
|
90 self assert: tree body statements first arguments first scope parent == tree scope. |
|
91 self assert: tree body statements first arguments first scope node == tree body statements first arguments first. |
|
92 self assert: tree body statements first arguments first scope children size == 1. |
|
93 self assert: tree body statements first arguments first scope variables isEmpty. |
|
94 |
|
95 self assert: tree body statements first arguments first "outer block" |
|
96 body statements first arguments first "inner block" scope parent |
|
97 == |
|
98 tree body statements first arguments first"outer block" scope. |
|
99 |
|
100 "Created: / 19-09-2015 / 06:11:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
22 ! ! |
101 ! ! |
23 |
102 |
|
103 !TSemanticAnalyserTests class methodsFor:'documentation'! |
|
104 |
|
105 version_HG |
|
106 |
|
107 ^ '$Changeset: <not expanded> $' |
|
108 ! ! |
|
109 |