Compiler-Tests.st 19 KB

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