1
0

Compiler-Tests.st 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810
  1. Smalltalk createPackage: 'Compiler-Tests'!
  2. TestCase subclass: #ASTParsingTest
  3. instanceVariableNames: ''
  4. package: 'Compiler-Tests'!
  5. !ASTParsingTest methodsFor: 'convenience'!
  6. analyze: aNode forClass: aClass
  7. (SemanticAnalyzer on: aClass) visit: aNode.
  8. ^ aNode
  9. ! !
  10. !ASTParsingTest methodsFor: 'parsing'!
  11. parse: aString
  12. ^ Smalltalk parse: aString
  13. !
  14. parse: aString forClass: aClass
  15. ^ self analyze: (self parse: aString) forClass: aClass
  16. ! !
  17. ASTParsingTest subclass: #ASTPCNodeVisitorTest
  18. instanceVariableNames: ''
  19. package: 'Compiler-Tests'!
  20. !ASTPCNodeVisitorTest methodsFor: 'factory'!
  21. astPCNodeVisitor
  22. ^ ASTPCNodeVisitor new
  23. index: 0;
  24. yourself
  25. !
  26. astPCNodeVisitorForSelector: aString
  27. ^ ASTPCNodeVisitor new
  28. selector: aString;
  29. index: 0;
  30. yourself
  31. ! !
  32. !ASTPCNodeVisitorTest methodsFor: 'tests'!
  33. testJSStatementNode
  34. | ast visitor |
  35. ast := self parse: 'foo <inlineJS: ''consolee.log(1)''>' forClass: Object.
  36. self assert: (self astPCNodeVisitor
  37. visit: ast;
  38. currentNode) isJSStatementNode
  39. !
  40. testLegacyJSStatementNode
  41. | ast visitor |
  42. ast := self parse: 'foo <consolee.log(1)>' forClass: Object.
  43. self assert: (self astPCNodeVisitor
  44. visit: ast;
  45. currentNode) isJSStatementNode
  46. !
  47. testMessageSend
  48. | ast |
  49. ast := self parse: 'foo self asString yourself. ^ self asBoolean' forClass: Object.
  50. self assert: ((self astPCNodeVisitorForSelector: 'yourself')
  51. visit: ast;
  52. currentNode) selector equals: 'yourself'
  53. !
  54. testMessageSendWithBlocks
  55. | ast |
  56. ast := self parse: 'foo true ifTrue: [ [ self asString yourself ] value. ]. ^ self asBoolean' forClass: Object.
  57. self assert: ((self astPCNodeVisitorForSelector: 'yourself')
  58. visit: ast;
  59. currentNode) selector equals: 'yourself'
  60. !
  61. testMessageSendWithInlining
  62. | ast |
  63. ast := self parse: 'foo true ifTrue: [ self asString yourself ]. ^ self asBoolean' forClass: Object.
  64. self assert: ((self astPCNodeVisitorForSelector: 'yourself')
  65. visit: ast;
  66. currentNode) selector equals: 'yourself'.
  67. ast := self parse: 'foo true ifTrue: [ self asString yourself ]. ^ self asBoolean' forClass: Object.
  68. self assert: ((self astPCNodeVisitorForSelector: 'asBoolean')
  69. visit: ast;
  70. currentNode) selector equals: 'asBoolean'
  71. !
  72. testNoMessageSend
  73. | ast |
  74. ast := self parse: 'foo ^ self' forClass: Object.
  75. self assert: (self astPCNodeVisitor
  76. visit: ast;
  77. currentNode) isNil
  78. ! !
  79. ASTParsingTest subclass: #ASTPositionTest
  80. instanceVariableNames: ''
  81. package: 'Compiler-Tests'!
  82. !ASTPositionTest methodsFor: 'tests'!
  83. testNodeAtPosition
  84. | node |
  85. node := self parse: 'yourself
  86. ^ self'.
  87. self assert: (node navigationNodeAt: 2@4 ifAbsent: [ nil ]) source equals: 'self'.
  88. node := self parse: 'foo
  89. true ifTrue: [ 1 ]'.
  90. self assert: (node navigationNodeAt: 2@7 ifAbsent: [ nil ]) selector equals: 'ifTrue:'.
  91. node := self parse: 'foo
  92. self foo; bar; baz'.
  93. self assert: (node navigationNodeAt: 2@8 ifAbsent: [ nil ]) selector equals: 'foo'
  94. ! !
  95. ASTParsingTest subclass: #CodeGeneratorTest
  96. instanceVariableNames: 'receiver'
  97. package: 'Compiler-Tests'!
  98. !CodeGeneratorTest methodsFor: 'accessing'!
  99. codeGeneratorClass
  100. ^ CodeGenerator
  101. ! !
  102. !CodeGeneratorTest methodsFor: 'factory'!
  103. compiler
  104. ^ Compiler new
  105. codeGeneratorClass: self codeGeneratorClass;
  106. yourself
  107. ! !
  108. !CodeGeneratorTest methodsFor: 'initialization'!
  109. setUp
  110. receiver := DoIt new
  111. !
  112. tearDown
  113. "receiver := nil"
  114. ! !
  115. !CodeGeneratorTest methodsFor: 'testing'!
  116. should: aString receiver: anObject raise: anErrorClass
  117. | method result |
  118. receiver := anObject.
  119. [ self should: [
  120. method := self compiler install: aString forClass: anObject class protocol: 'tests'.
  121. receiver perform: method selector ] raise: anErrorClass ]
  122. ensure: [ method ifNotNil: [ anObject class removeCompiledMethod: method ] ]
  123. !
  124. should: aString receiver: anObject return: aResult
  125. | method result |
  126. receiver := anObject.
  127. method := self compiler install: aString forClass: anObject class protocol: 'tests'.
  128. result := receiver perform: method selector.
  129. anObject class removeCompiledMethod: method.
  130. self assert: aResult equals: result
  131. !
  132. should: aString return: anObject
  133. ^ self
  134. should: aString
  135. receiver: receiver
  136. return: anObject
  137. ! !
  138. !CodeGeneratorTest methodsFor: 'tests'!
  139. testAssignment
  140. self should: 'foo | a | a := true ifTrue: [ 1 ]. ^ a' return: 1.
  141. self should: 'foo | a | a := false ifTrue: [ 1 ]. ^ a' return: nil.
  142. self should: 'foo | a | ^ a := true ifTrue: [ 1 ]' return: 1
  143. !
  144. testBackslashSelectors
  145. self should: '\ arg ^ 4' return: 4.
  146. self should: '\\ arg ^ 42' return: 42
  147. !
  148. testBlockReturn
  149. self should: 'foo ^ #(1 2 3) collect: [ :each | true ifTrue: [ each + 1 ] ]' return: #(2 3 4).
  150. self should: 'foo ^ #(1 2 3) collect: [ :each | false ifFalse: [ each + 1 ] ]' return: #(2 3 4).
  151. self should: 'foo ^ #(1 2 3) collect: [ :each | each odd ifTrue: [ each + 1 ] ifFalse: [ each - 1 ] ]' return: #(2 1 4).
  152. !
  153. testCascades
  154. self should: 'foo ^ Array new add: 3; add: 4; yourself' return: #(3 4)
  155. !
  156. testCascadesInDynamicArray
  157. self should: 'foo | x | x := 1. ^ {x. [x:=2] value; in: [x]}' return: #(1 2)
  158. !
  159. testCascadesInDynamicDictioary
  160. self should: 'foo | x | x := 1. ^ #{''one'' -> x. ''two'' -> ([x:=2] value; in: [x])}' return: #{'one' -> 1. 'two' -> 2}
  161. !
  162. testCascadesInSend
  163. self should: 'foo | x | x := 1. ^ Array with: x with: ([x:=2] value; in: [x])' return: #(1 2)
  164. !
  165. testCascadesWithInlining
  166. self should: 'foo ^ true class; ifTrue: [ 1 ] ifFalse: [ 2 ]' return: 1.
  167. self should: 'foo ^ false class; ifTrue: [ 1 ] ifFalse: [ 2 ]' return: 2
  168. !
  169. testDynamicArrayElementsOrdered
  170. self should: 'foo
  171. | x |
  172. x := 1.
  173. ^ { x. x := 2 }
  174. ' return: #(1 2).
  175. self should: 'foo
  176. | x |
  177. x := 1.
  178. ^ { x. true ifTrue: [ x := 2 ] }
  179. ' return: #(1 2).
  180. !
  181. testDynamicDictionaryElementsOrdered
  182. self should: 'foo
  183. | x |
  184. x := ''foo''.
  185. ^ #{ x->1. ''bar''->(true ifTrue: [ 2 ]) }
  186. ' return: #{'foo'->1. 'bar'->2}.
  187. !
  188. testDynamicDictionaryWithMoreArrows
  189. self should: 'foo ^ #{1->2->3}' return: (HashedCollection with: 1->2->3)
  190. !
  191. testGlobalVar
  192. self should: 'foo ^ eval class' return: BlockClosure.
  193. self should: 'foo ^ Math cos: 0' return: 1.
  194. self should: 'foo ^ NonExistingVar' return: nil
  195. !
  196. testInnerTemporalDependentElementsOrdered
  197. self should: 'foo
  198. | x |
  199. x := Array.
  200. ^ x with: ''foo''->x with: ''bar''->(x := 2)
  201. ' return: {'foo'->Array. 'bar'->2}.
  202. self should: 'foo
  203. | x |
  204. x := Array.
  205. ^ x with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  206. ' return: {'foo'->Array. 'bar'->2}.
  207. self should: 'foo
  208. | x |
  209. x := 1.
  210. ^ Array with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  211. ' return: {'foo'->1. 'bar'->2}.
  212. self should: 'foo
  213. | x |
  214. x := 1.
  215. ^ { ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  216. ' return: {'foo'->1. 'bar'->2}.
  217. self should: 'foo
  218. | x |
  219. x := 1.
  220. ^ #{ ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  221. ' return: #{'foo'->1. 'bar'->2}.
  222. !
  223. testJSStatement
  224. self should: 'foo <return 2+3>' return: 5
  225. !
  226. testLexicalScope
  227. self should: 'foo | a | a := 1. [ a := 2 ] value. ^ a' return: 2
  228. !
  229. testLiterals
  230. self should: 'foo ^ 1' return: 1.
  231. self should: 'foo ^ ''hello''' return: 'hello'.
  232. self should: 'foo ^ #(1 2 3 4)' return: #(1 2 3 4).
  233. self should: 'foo ^ {1. [:x | x ] value: 2. 3. [4] value}' return: #(1 2 3 4).
  234. self should: 'foo ^ true' return: true.
  235. self should: 'foo ^ false' return: false.
  236. self should: 'foo ^ #{1->2. 3->4}' return: #{1->2. 3->4}.
  237. self should: 'foo ^ #hello' return: #hello.
  238. self should: 'foo ^ $h' return: 'h'.
  239. self should: 'foo ^ -123.456' return: -123.456.
  240. self should: 'foo ^ -2.5e4' return: -25000.
  241. !
  242. testLocalReturn
  243. self should: 'foo ^ 1' return: 1.
  244. self should: 'foo ^ 1 + 1' return: 2.
  245. self should: 'foo ' return: receiver.
  246. self should: 'foo self asString' return: receiver.
  247. self should: 'foo | a b | a := 1. b := 2. ^ a + b' return: 3
  248. !
  249. testMessageSends
  250. self should: 'foo ^ 1 asString' return: '1'.
  251. self should: 'foo ^ 1 + 1' return: 2.
  252. self should: 'foo ^ 1 + 2 * 3' return: 9.
  253. self should: 'foo ^ 1 to: 3' return: #(1 2 3).
  254. self should: 'foo ^ 1 to: 5 by: 2' return: #(1 3 5)
  255. !
  256. testMistypedPragmaJSStatement
  257. self should: 'foo < inlineJS: ''return ''foo'''' >' receiver: receiver raise: ParseError
  258. !
  259. testMultipleSequences
  260. self should: 'foo | a b c | a := 2. b := 3. c := a + b. ^ c * 6' return: 30
  261. !
  262. testMutableLiterals
  263. "Mutable literals must be aliased in cascades.
  264. See https://lolg.it/amber/amber/issues/428"
  265. self
  266. should: 'foo ^ #( 1 2 ) at: 1 put: 3; yourself'
  267. return: #(3 2)
  268. !
  269. testNestedIfTrue
  270. self should: 'foo ^ true ifTrue: [ false ifFalse: [ 1 ] ]' return: 1.
  271. self should: 'foo ^ true ifTrue: [ false ifTrue: [ 1 ] ]' return: nil.
  272. self should: 'foo true ifTrue: [ false ifFalse: [ ^ 1 ] ]' return: 1.
  273. self should: 'foo true ifTrue: [ false ifTrue: [ ^ 1 ] ]' return: receiver.
  274. !
  275. testNestedSends
  276. self should: 'foo ^ (Point x: (Point x: 2 y: 3) y: 4) asString' return: (Point x: (2@3) y: 4) asString
  277. !
  278. testNonLocalReturn
  279. self should: 'foo [ ^ 1 ] value' return: 1.
  280. self should: 'foo [ ^ 1 + 1 ] value' return: 2.
  281. self should: 'foo | a b | a := 1. b := 2. [ ^ a + b ] value. self halt' return: 3.
  282. self should: 'foo [ :x | ^ x + x ] value: 4. ^ 2' return: 8
  283. !
  284. testPascalCaseGlobal
  285. self should: 'foo ^Object' return: (Smalltalk globals at: 'Object').
  286. self should: 'foo ^NonExistent' return: nil
  287. !
  288. testPragmaJSStatement
  289. self should: 'foo < inlineJS: ''return 2+3'' >' return: 5
  290. !
  291. testRootSuperSend
  292. self
  293. should: 'foo ^ super class'
  294. receiver: ProtoObject new
  295. raise: MessageNotUnderstood
  296. !
  297. testSendReceiverAndArgumentsOrdered
  298. self should: 'foo
  299. | x |
  300. x := 1.
  301. ^ Array with: x with: (true ifTrue: [ x := 2 ])
  302. ' return: #(1 2).
  303. self should: 'foo
  304. | x |
  305. x := Array.
  306. ^ x with: x with: (true ifTrue: [ x := 2 ])
  307. ' return: {Array. 2}.
  308. !
  309. testSuperSend
  310. self
  311. should: 'foo ^ super isBoolean'
  312. receiver: true
  313. return: false
  314. !
  315. testTempVariables
  316. self should: 'foo | a | ^ a' return: nil.
  317. self should: 'foo | AVariable | ^ AVariable' return: nil.
  318. self should: 'foo | a b c | ^ c' return: nil.
  319. self should: 'foo | a | [ | d | ^ d ] value' return: nil.
  320. self should: 'foo | a | a:= 1. ^ a' return: 1.
  321. self should: 'foo | AVariable | AVariable := 1. ^ AVariable' return: 1.
  322. !
  323. testThisContext
  324. self should: 'foo ^ [ thisContext ] value outerContext == thisContext' return: true
  325. !
  326. testifFalse
  327. self should: 'foo true ifFalse: [ ^ 1 ]' return: receiver.
  328. self should: 'foo false ifFalse: [ ^ 2 ]' return: 2.
  329. self should: 'foo ^ true ifFalse: [ 1 ]' return: nil.
  330. self should: 'foo ^ false ifFalse: [ 2 ]' return: 2.
  331. !
  332. testifFalseIfTrue
  333. self should: 'foo true ifFalse: [ ^ 1 ] ifTrue: [ ^ 2 ]' return: 2.
  334. self should: 'foo false ifFalse: [ ^ 2 ] ifTrue: [ ^1 ]' return: 2.
  335. self should: 'foo ^ true ifFalse: [ 1 ] ifTrue: [ 2 ]' return: 2.
  336. self should: 'foo ^ false ifFalse: [ 2 ] ifTrue: [ 1 ]' return: 2.
  337. !
  338. testifNil
  339. self should: 'foo ^ 1 ifNil: [ 2 ]' return: 1.
  340. self should: 'foo ^ nil ifNil: [ 2 ]' return: 2.
  341. self should: 'foo 1 ifNil: [ ^ 2 ]' return: receiver.
  342. self should: 'foo nil ifNil: [ ^ 2 ]' return: 2.
  343. !
  344. testifNilIfNotNil
  345. self should: 'foo ^ 1 ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 3.
  346. self should: 'foo ^ nil ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 2.
  347. self should: 'foo 1 ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 3.
  348. self should: 'foo nil ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 2.
  349. !
  350. testifNotNil
  351. self should: 'foo ^ 1 ifNotNil: [ 2 ]' return: 2.
  352. self should: 'foo ^ nil ifNotNil: [ 2 ]' return: nil.
  353. self should: 'foo 1 ifNotNil: [ ^ 2 ]' return: 2.
  354. self should: 'foo nil ifNotNil: [ ^ 2 ]' return: receiver.
  355. !
  356. testifNotNilWithArgument
  357. self should: 'foo ^ 1 ifNotNil: [ :val | val + 2 ]' return: 3.
  358. self should: 'foo ^ nil ifNotNil: [ :val | val + 2 ]' return: nil.
  359. self should: 'foo ^ 1 ifNil: [ 5 ] ifNotNil: [ :val | val + 2 ]' return: 3.
  360. self should: 'foo ^ nil ifNil: [ 5 ] ifNotNil: [ :val | val + 2 ]' return: 5.
  361. self should: 'foo ^ 1 ifNotNil: [ :val | val + 2 ] ifNil: [ 5 ]' return: 3.
  362. self should: 'foo ^ nil ifNotNil: [ :val | val + 2 ] ifNil: [ 5 ]' return: 5
  363. !
  364. testifTrue
  365. self should: 'foo false ifTrue: [ ^ 1 ]' return: receiver.
  366. self should: 'foo true ifTrue: [ ^ 2 ]' return: 2.
  367. self should: 'foo ^ false ifTrue: [ 1 ]' return: nil.
  368. self should: 'foo ^ true ifTrue: [ 2 ]' return: 2.
  369. !
  370. testifTrueIfFalse
  371. self should: 'foo false ifTrue: [ ^ 1 ] ifFalse: [ ^2 ]' return: 2.
  372. self should: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ ^ 2 ]' return: 1.
  373. self should: 'foo ^ false ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 1.
  374. self should: 'foo ^ true ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 2.
  375. ! !
  376. CodeGeneratorTest subclass: #ASTInterpreterTest
  377. instanceVariableNames: ''
  378. package: 'Compiler-Tests'!
  379. !ASTInterpreterTest methodsFor: 'parsing'!
  380. analyze: aNode forClass: aClass
  381. (SemanticAnalyzer on: aClass) visit: aNode.
  382. ^ aNode
  383. !
  384. parse: aString
  385. ^ Smalltalk parse: aString
  386. !
  387. parse: aString forClass: aClass
  388. ^ self analyze: (self parse: aString) forClass: aClass
  389. ! !
  390. !ASTInterpreterTest methodsFor: 'private'!
  391. interpret: aString receiver: anObject withArguments: aDictionary
  392. "The food is a methodNode. Interpret the sequenceNode only"
  393. | ctx ast interpreter |
  394. interpreter := ASTInterpreter new.
  395. ast := self parse: aString forClass: anObject class.
  396. ctx := AIContext new
  397. receiver: anObject;
  398. interpreter: interpreter;
  399. yourself.
  400. "Define locals for the context"
  401. ast sequenceNode ifNotNil: [ :sequence |
  402. sequence temps do: [ :each |
  403. ctx defineLocal: each ] ].
  404. aDictionary keysAndValuesDo: [ :key :value |
  405. ctx localAt: key put: value ].
  406. ^ interpreter
  407. context: ctx;
  408. node: ast;
  409. enterNode;
  410. proceed;
  411. result
  412. ! !
  413. !ASTInterpreterTest methodsFor: 'testing'!
  414. should: aString receiver: anObject return: aResult
  415. receiver := anObject.
  416. ^ self
  417. assert: (self interpret: aString receiver: receiver withArguments: #{})
  418. equals: aResult
  419. ! !
  420. ASTInterpreterTest subclass: #ASTDebuggerTest
  421. instanceVariableNames: ''
  422. package: 'Compiler-Tests'!
  423. !ASTDebuggerTest methodsFor: 'private'!
  424. interpret: aString receiver: anObject withArguments: aDictionary
  425. | ctx ast debugger |
  426. ctx := AIContext new
  427. receiver: anObject;
  428. interpreter: ASTInterpreter new;
  429. yourself.
  430. ast := self parse: aString forClass: anObject class.
  431. "Define locals for the context"
  432. ast sequenceNode ifNotNil: [ :sequence |
  433. sequence temps do: [ :each |
  434. ctx defineLocal: each ] ].
  435. aDictionary keysAndValuesDo: [ :key :value |
  436. ctx localAt: key put: value ].
  437. ctx interpreter context: ctx.
  438. ctx interpreter node: ast; enterNode.
  439. debugger := ASTDebugger context: ctx.
  440. ^ debugger
  441. proceed;
  442. result
  443. ! !
  444. CodeGeneratorTest subclass: #InliningCodeGeneratorTest
  445. instanceVariableNames: ''
  446. package: 'Compiler-Tests'!
  447. !InliningCodeGeneratorTest methodsFor: 'accessing'!
  448. codeGeneratorClass
  449. ^ InliningCodeGenerator
  450. ! !
  451. TestCase subclass: #ScopeVarTest
  452. instanceVariableNames: ''
  453. package: 'Compiler-Tests'!
  454. !ScopeVarTest methodsFor: 'tests'!
  455. testClassRefVar
  456. | node |
  457. node := VariableNode new
  458. value: 'Object';
  459. yourself.
  460. SemanticAnalyzer new
  461. pushScope: MethodLexicalScope new;
  462. visit: node.
  463. self assert: node binding isClassRefVar
  464. !
  465. testInstanceVar
  466. | node scope |
  467. node := VariableNode new
  468. value: 'bzzz';
  469. yourself.
  470. scope := MethodLexicalScope new.
  471. scope addIVar: 'bzzz'.
  472. self assert: (scope bindingFor: node) isInstanceVar
  473. !
  474. testPseudoVar
  475. | node pseudoVars |
  476. pseudoVars := #('self' 'super' 'true' 'false' 'nil').
  477. pseudoVars do: [:each |
  478. node := VariableNode new
  479. value: each;
  480. yourself.
  481. self assert: (MethodLexicalScope new bindingFor: node) isPseudoVar]
  482. !
  483. testTempVar
  484. | node scope |
  485. node := VariableNode new
  486. value: 'bzzz';
  487. yourself.
  488. scope := MethodLexicalScope new.
  489. scope addTemp: 'bzzz'.
  490. self assert: (scope bindingFor: node) isTempVar
  491. !
  492. testUnknownVar
  493. | node |
  494. node := VariableNode new
  495. value: 'bzzz';
  496. yourself.
  497. self assert: (MethodLexicalScope new bindingFor: node) isNil
  498. ! !
  499. TestCase subclass: #SemanticAnalyzerTest
  500. instanceVariableNames: 'analyzer'
  501. package: 'Compiler-Tests'!
  502. !SemanticAnalyzerTest methodsFor: 'running'!
  503. setUp
  504. analyzer := SemanticAnalyzer on: Object
  505. ! !
  506. !SemanticAnalyzerTest methodsFor: 'tests'!
  507. testAssignment
  508. | src ast |
  509. src := 'foo self := 1'.
  510. ast := Smalltalk parse: src.
  511. self should: [analyzer visit: ast] raise: InvalidAssignmentError
  512. !
  513. testNonLocalReturn
  514. | src ast |
  515. src := 'foo | a | a + 1. ^ a'.
  516. ast := Smalltalk parse: src.
  517. analyzer visit: ast.
  518. self deny: ast scope hasNonLocalReturn
  519. !
  520. testNonLocalReturn2
  521. | src ast |
  522. src := 'foo | a | a + 1. [ [ ^ a] ]'.
  523. ast := Smalltalk parse: src.
  524. analyzer visit: ast.
  525. self assert: ast scope hasNonLocalReturn
  526. !
  527. testScope
  528. | src ast |
  529. src := 'foo | a | a + 1. [ | b | b := a ]'.
  530. ast := Smalltalk parse: src.
  531. analyzer visit: ast.
  532. self deny: ast dagChildren first dagChildren last scope == ast scope.
  533. !
  534. testScope2
  535. | src ast |
  536. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  537. ast := Smalltalk parse: src.
  538. analyzer visit: ast.
  539. self deny: ast dagChildren first dagChildren last dagChildren first dagChildren first scope == ast scope.
  540. !
  541. testScopeLevel
  542. | src ast |
  543. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  544. ast := Smalltalk parse: src.
  545. analyzer visit: ast.
  546. self assert: ast scope scopeLevel equals: 1.
  547. self assert: ast dagChildren first dagChildren last dagChildren first dagChildren first scope scopeLevel equals: 3
  548. !
  549. testUnknownVariables
  550. | src ast |
  551. src := 'foo | a | b + a'.
  552. ast := Smalltalk parse: src.
  553. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  554. !
  555. testUnknownVariablesWithScope
  556. | src ast |
  557. src := 'foo | a b | [ c + 1. [ a + 1. d + 1 ]]'.
  558. ast := Smalltalk parse: src.
  559. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  560. !
  561. testVariableShadowing
  562. | src ast |
  563. src := 'foo | a | a + 1'.
  564. ast := Smalltalk parse: src.
  565. analyzer visit: ast
  566. !
  567. testVariableShadowing2
  568. | src ast |
  569. src := 'foo | a | a + 1. [ | a | a := 2 ]'.
  570. ast := Smalltalk parse: src.
  571. self should: [analyzer visit: ast] raise: ShadowingVariableError
  572. !
  573. testVariableShadowing3
  574. | src ast |
  575. src := 'foo | a | a + 1. [ | b | b := 2 ]'.
  576. ast := Smalltalk parse: src.
  577. analyzer visit: ast
  578. !
  579. testVariableShadowing4
  580. | src ast |
  581. src := 'foo | a | a + 1. [ [ [ | b | b := 2 ] ] ]'.
  582. ast := Smalltalk parse: src.
  583. analyzer visit: ast
  584. !
  585. testVariableShadowing5
  586. | src ast |
  587. src := 'foo | a | a + 1. [ [ [ | a | a := 2 ] ] ]'.
  588. ast := Smalltalk parse: src.
  589. self should: [analyzer visit: ast] raise: ShadowingVariableError
  590. !
  591. testVariablesLookup
  592. | src ast |
  593. src := 'foo | a | a + 1. [ | b | b := a ]'.
  594. ast := Smalltalk parse: src.
  595. analyzer visit: ast.
  596. "Binding for `a` in the message send"
  597. self assert: ast dagChildren first dagChildren first receiver binding isTempVar.
  598. self assert: ast dagChildren first dagChildren first receiver binding scope == ast scope.
  599. "Binding for `b`"
  600. self assert: ast dagChildren first dagChildren last dagChildren first dagChildren first left binding isTempVar.
  601. self assert: ast dagChildren first dagChildren last dagChildren first dagChildren first left binding scope == ast dagChildren first dagChildren last scope.
  602. ! !
  603. SemanticAnalyzerTest subclass: #AISemanticAnalyzerTest
  604. instanceVariableNames: ''
  605. package: 'Compiler-Tests'!
  606. !AISemanticAnalyzerTest methodsFor: 'running'!
  607. setUp
  608. analyzer := (AISemanticAnalyzer on: Object)
  609. context: (AIContext new
  610. defineLocal: 'local';
  611. localAt: 'local' put: 3;
  612. yourself);
  613. yourself
  614. ! !
  615. !AISemanticAnalyzerTest methodsFor: 'tests'!
  616. testContextVariables
  617. | src ast |
  618. src := 'foo | a | local + a'.
  619. ast := Smalltalk parse: src.
  620. self shouldnt: [ analyzer visit: ast ] raise: UnknownVariableError
  621. ! !