1
0

Compiler-Tests.st 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631
  1. Smalltalk current createPackage: 'Compiler-Tests'!
  2. TestCase subclass: #AbstractASTInterpreterTest
  3. instanceVariableNames: ''
  4. package: 'Compiler-Tests'!
  5. !AbstractASTInterpreterTest methodsFor: 'accessing'!
  6. interpreter
  7. ^ self subclassResponsibility
  8. ! !
  9. !AbstractASTInterpreterTest methodsFor: 'interpreting'!
  10. analyze: aNode forClass: aClass
  11. (SemanticAnalyzer on: aClass) visit: aNode.
  12. ^ aNode
  13. !
  14. interpret: aString
  15. ^ self
  16. interpret: aString
  17. withArguments: Dictionary new
  18. !
  19. interpret: aString receiver: anObject withArguments: aDictionary
  20. "The food is a methodNode. Interpret the sequenceNode only"
  21. | ctx |
  22. ctx := AIContext new.
  23. ctx receiver: anObject.
  24. aDictionary keysAndValuesDo: [ :key :value |
  25. ctx localAt: key put: value ].
  26. ^ self interpreter
  27. context: ctx;
  28. interpret: (self parse: aString forClass: anObject class)
  29. nodes first;
  30. result
  31. !
  32. interpret: aString withArguments: aDictionary
  33. ^ self
  34. interpret: aString
  35. receiver: Object new
  36. withArguments: aDictionary
  37. ! !
  38. !AbstractASTInterpreterTest methodsFor: 'parsing'!
  39. parse: aString
  40. ^ Smalltalk current parse: aString
  41. !
  42. parse: aString forClass: aClass
  43. ^ self analyze: (self parse: aString) forClass: aClass
  44. ! !
  45. AbstractASTInterpreterTest subclass: #ASTInterpreterTest
  46. instanceVariableNames: ''
  47. package: 'Compiler-Tests'!
  48. !ASTInterpreterTest methodsFor: 'accessing'!
  49. interpreter
  50. ^ ASTInterpreter new
  51. ! !
  52. !ASTInterpreterTest methodsFor: 'tests'!
  53. testBinarySend
  54. self assert: (self interpret: 'foo 2+3+4') equals: 9
  55. !
  56. testBlockLiteral
  57. self assert: (self interpret: 'foo ^ true ifTrue: [ 1 ] ifFalse: [ 2 ]') equals: 1.
  58. self assert: (self interpret: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ 2 ]') equals: 1.
  59. self assert: (self interpret: 'foo ^ false ifTrue: [ 1 ] ifFalse: [ 2 ]') equals: 2
  60. !
  61. testCascade
  62. self assert: (self interpret: 'foo ^ OrderedCollection new add: 2; add: 3; yourself') equals: (OrderedCollection with: 2 with: 3)
  63. !
  64. testDynamicArray
  65. self assert: (self interpret: 'foo ^ {1+1. 2+2}') equals: #(2 4)
  66. !
  67. testDynamicDictionary
  68. self assert: (self interpret: 'foo ^ #{1->1. 2->3}') equals: #{1->1. 2->3}
  69. !
  70. testInlinedJSStatement
  71. self assert: (self interpret: 'foo <return 2+3>') equals: 5.
  72. self
  73. assert: (self
  74. interpret: 'foo: anInteger <return 2 + anInteger>'
  75. withArguments: #{ 'anInteger' -> 3})
  76. equals: 5
  77. !
  78. testInstVarAccess
  79. self
  80. assert: (self
  81. interpret: 'foo ^ x'
  82. receiver: 2@3
  83. withArguments: #{})
  84. equals: 2
  85. !
  86. testInstVarAssignment
  87. self
  88. assert: (self
  89. interpret: 'foo: anInteger x := anInteger. ^ x'
  90. receiver: Point new
  91. withArguments: #{'anInteger' -> 2})
  92. equals: 2
  93. !
  94. testNonlocalReturn
  95. self assert: (self interpret: 'foo true ifTrue: [ ^ 1 ]. ^2') equals: 1
  96. !
  97. testReceiver
  98. self
  99. assert: (self
  100. interpret: 'foo ^ self'
  101. receiver: 2@3
  102. withArguments: #{})
  103. equals: 2@3
  104. !
  105. testTempAssignment
  106. self assert: (self interpret: 'foo | a | a := 2. ^ a') equals: 2
  107. ! !
  108. AbstractASTInterpreterTest subclass: #ASTSteppingInterpreterTest
  109. instanceVariableNames: 'interpreter'
  110. package: 'Compiler-Tests'!
  111. !ASTSteppingInterpreterTest methodsFor: 'accessing'!
  112. interpreter
  113. ^ interpreter ifNil: [ interpreter := ASTSteppingInterpreter new ]
  114. ! !
  115. !ASTSteppingInterpreterTest methodsFor: 'tests'!
  116. testAtEnd
  117. self interpret: 'foo 1 + 2'.
  118. self deny: self interpreter atEnd.
  119. self interpreter step.
  120. self deny: self interpreter atEnd.
  121. self interpreter step.
  122. self deny: self interpreter atEnd.
  123. self interpreter step.
  124. self deny: self interpreter atEnd.
  125. self interpreter step.
  126. self assert: self interpreter atEnd
  127. !
  128. testMessageSend
  129. self interpret: 'foo 1 + 2'.
  130. "SequenceNode"
  131. self interpreter step.
  132. "SendNode"
  133. self interpreter step.
  134. "ValueNode"
  135. self interpreter step.
  136. self assert: self interpreter currentNode value equals: 1.
  137. "ValueNode"
  138. self interpreter step.
  139. self assert: self interpreter currentNode value equals: 2.
  140. "Result"
  141. self interpreter step.
  142. self assert: self interpreter result equals: 3
  143. !
  144. testSimpleStepping
  145. self interpret: 'foo 1'.
  146. "SequenceNode"
  147. self interpreter step.
  148. self assert: self interpreter result isNil.
  149. "ValueNode"
  150. self interpreter step.
  151. self assert: self interpreter result equals: 1
  152. ! !
  153. TestCase subclass: #CodeGeneratorTest
  154. instanceVariableNames: 'receiver'
  155. package: 'Compiler-Tests'!
  156. !CodeGeneratorTest methodsFor: 'accessing'!
  157. codeGeneratorClass
  158. ^ CodeGenerator
  159. !
  160. targetClass
  161. ^ DoIt
  162. ! !
  163. !CodeGeneratorTest methodsFor: 'factory'!
  164. compiler
  165. ^ Compiler new
  166. codeGeneratorClass: self codeGeneratorClass;
  167. yourself
  168. ! !
  169. !CodeGeneratorTest methodsFor: 'initialization'!
  170. setUp
  171. receiver := self targetClass new
  172. !
  173. tearDown
  174. "receiver := nil"
  175. ! !
  176. !CodeGeneratorTest methodsFor: 'testing'!
  177. should: aString return: anObject
  178. | method result |
  179. method := self compiler install: aString forClass: self targetClass category: 'tests'.
  180. result := receiver perform: method selector.
  181. self targetClass removeCompiledMethod: method.
  182. self assert: anObject equals: result
  183. ! !
  184. !CodeGeneratorTest methodsFor: 'tests'!
  185. testAssignment
  186. self should: 'foo | a | a := true ifTrue: [ 1 ]. ^ a' return: 1.
  187. self should: 'foo | a | a := false ifTrue: [ 1 ]. ^ a' return: nil.
  188. self should: 'foo | a | ^ a := true ifTrue: [ 1 ]' return: 1
  189. !
  190. testBlockReturn
  191. self should: 'foo ^ #(1 2 3) collect: [ :each | true ifTrue: [ each + 1 ] ]' return: #(2 3 4).
  192. self should: 'foo ^ #(1 2 3) collect: [ :each | false ifFalse: [ each + 1 ] ]' return: #(2 3 4).
  193. self should: 'foo ^ #(1 2 3) collect: [ :each | each odd ifTrue: [ each + 1 ] ifFalse: [ each - 1 ] ]' return: #(2 1 4).
  194. !
  195. testCascades
  196. self should: 'foo ^ Array new add: 3; add: 4; yourself' return: #(3 4)
  197. !
  198. testDynamicArrayElementsOrdered
  199. self should: 'foo
  200. | x |
  201. x := 1.
  202. ^ { x. true ifTrue: [ x := 2 ] }
  203. ' return: #(1 2).
  204. !
  205. testDynamicDictionaryElementsOrdered
  206. self should: 'foo
  207. | x |
  208. x := ''foo''->1.
  209. ^ #{ x. (true ifTrue: [ x := ''bar''->2 ]) }
  210. ' return: #{'foo'->1. 'bar'->2}.
  211. !
  212. testInnerTemporalDependentElementsOrdered
  213. self should: 'foo
  214. | x |
  215. x := Array.
  216. ^ x with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  217. ' return: {'foo'->Array. 'bar'->2}.
  218. self should: 'foo
  219. | x |
  220. x := 1.
  221. ^ Array with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  222. ' return: {'foo'->1. 'bar'->2}.
  223. self should: 'foo
  224. | x |
  225. x := 1.
  226. ^ { ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  227. ' return: {'foo'->1. 'bar'->2}.
  228. self should: 'foo
  229. | x |
  230. x := 1.
  231. ^ #{ ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  232. ' return: #{'foo'->1. 'bar'->2}.
  233. !
  234. testLiterals
  235. self should: 'foo ^ 1' return: 1.
  236. self should: 'foo ^ ''hello''' return: 'hello'.
  237. self should: 'foo ^ #(1 2 3 4)' return: #(1 2 3 4).
  238. self should: 'foo ^ {1. [:x | x ] value: 2. 3. [4] value}' return: #(1 2 3 4).
  239. self should: 'foo ^ true' return: true.
  240. self should: 'foo ^ false' return: false.
  241. self should: 'foo ^ #{1->2. 3->4}' return: #{1->2. 3->4}.
  242. self should: 'foo ^ #hello' return: #hello.
  243. self should: 'foo ^ -123.456' return: -123.456
  244. !
  245. testLocalReturn
  246. self should: 'foo ^ 1' return: 1.
  247. self should: 'foo ^ 1 + 1' return: 2.
  248. self should: 'foo ' return: receiver.
  249. self should: 'foo self asString' return: receiver.
  250. self should: 'foo | a b | a := 1. b := 2. ^ a + b' return: 3
  251. !
  252. testMessageSends
  253. self should: 'foo ^ 1 asString' return: '1'.
  254. self should: 'foo ^ 1 + 1' return: 2.
  255. self should: 'foo ^ 1 + 2 * 3' return: 9.
  256. self should: 'foo ^ 1 to: 3' return: #(1 2 3).
  257. self should: 'foo ^ 1 to: 5 by: 2' return: #(1 3 5)
  258. !
  259. testMutableLiterals
  260. "Mutable literals must be aliased in cascades.
  261. See https://github.com/amber-smalltalk/amber/issues/428"
  262. self
  263. should: 'foo ^ #( 1 2 ) at: 1 put: 3; yourself'
  264. return: #(3 2)
  265. !
  266. testNestedIfTrue
  267. self should: 'foo ^ true ifTrue: [ false ifFalse: [ 1 ] ]' return: 1.
  268. self should: 'foo ^ true ifTrue: [ false ifTrue: [ 1 ] ]' return: nil.
  269. self should: 'foo true ifTrue: [ false ifFalse: [ ^ 1 ] ]' return: 1.
  270. self should: 'foo true ifTrue: [ false ifTrue: [ ^ 1 ] ]' return: receiver.
  271. !
  272. testNonLocalReturn
  273. self should: 'foo [ ^ 1 ] value' return: 1.
  274. self should: 'foo [ ^ 1 + 1 ] value' return: 2.
  275. self should: 'foo | a b | a := 1. b := 2. [ ^ a + b ] value. self halt' return: 3.
  276. self should: 'foo [ :x | ^ x + x ] value: 4. ^ 2' return: 8
  277. !
  278. testSendReceiverAndArgumentsOrdered
  279. self should: 'foo
  280. | x |
  281. x := 1.
  282. ^ Array with: x with: (true ifTrue: [ x := 2 ])
  283. ' return: #(1 2).
  284. self should: 'foo
  285. | x |
  286. x := Array.
  287. ^ x with: x with: (true ifTrue: [ x := 2 ])
  288. ' return: {Array. 2}.
  289. !
  290. testifFalse
  291. self should: 'foo true ifFalse: [ ^ 1 ]' return: receiver.
  292. self should: 'foo false ifFalse: [ ^ 2 ]' return: 2.
  293. self should: 'foo ^ true ifFalse: [ 1 ]' return: nil.
  294. self should: 'foo ^ false ifFalse: [ 2 ]' return: 2.
  295. !
  296. testifFalseIfTrue
  297. self should: 'foo true ifFalse: [ ^ 1 ] ifTrue: [ ^ 2 ]' return: 2.
  298. self should: 'foo false ifFalse: [ ^ 2 ] ifTrue: [ ^1 ]' return: 2.
  299. self should: 'foo ^ true ifFalse: [ 1 ] ifTrue: [ 2 ]' return: 2.
  300. self should: 'foo ^ false ifFalse: [ 2 ] ifTrue: [ 1 ]' return: 2.
  301. !
  302. testifNil
  303. self should: 'foo ^ 1 ifNil: [ 2 ]' return: 1.
  304. self should: 'foo ^ nil ifNil: [ 2 ]' return: 2.
  305. self should: 'foo 1 ifNil: [ ^ 2 ]' return: receiver.
  306. self should: 'foo nil ifNil: [ ^ 2 ]' return: 2.
  307. !
  308. testifNilIfNotNil
  309. self should: 'foo ^ 1 ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 3.
  310. self should: 'foo ^ nil ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 2.
  311. self should: 'foo 1 ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 3.
  312. self should: 'foo nil ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 2.
  313. !
  314. testifNotNil
  315. self should: 'foo ^ 1 ifNotNil: [ 2 ]' return: 2.
  316. self should: 'foo ^ nil ifNotNil: [ 2 ]' return: nil.
  317. self should: 'foo 1 ifNotNil: [ ^ 2 ]' return: 2.
  318. self should: 'foo nil ifNotNil: [ ^ 2 ]' return: receiver.
  319. !
  320. testifTrue
  321. self should: 'foo false ifTrue: [ ^ 1 ]' return: receiver.
  322. self should: 'foo true ifTrue: [ ^ 2 ]' return: 2.
  323. self should: 'foo ^ false ifTrue: [ 1 ]' return: nil.
  324. self should: 'foo ^ true ifTrue: [ 2 ]' return: 2.
  325. !
  326. testifTrueIfFalse
  327. self should: 'foo false ifTrue: [ ^ 1 ] ifFalse: [ ^2 ]' return: 2.
  328. self should: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ ^ 2 ]' return: 1.
  329. self should: 'foo ^ false ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 1.
  330. self should: 'foo ^ true ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 2.
  331. ! !
  332. CodeGeneratorTest subclass: #InliningCodeGeneratorTest
  333. instanceVariableNames: ''
  334. package: 'Compiler-Tests'!
  335. !InliningCodeGeneratorTest methodsFor: 'accessing'!
  336. codeGeneratorClass
  337. ^ InliningCodeGenerator
  338. ! !
  339. TestCase subclass: #ScopeVarTest
  340. instanceVariableNames: ''
  341. package: 'Compiler-Tests'!
  342. !ScopeVarTest methodsFor: 'tests'!
  343. testClassRefVar
  344. | node |
  345. node := ClassReferenceNode new
  346. value: 'Object';
  347. yourself.
  348. SemanticAnalyzer new visit: node.
  349. self assert: node binding isClassRefVar
  350. !
  351. testInstanceVar
  352. | node scope |
  353. node := VariableNode new
  354. value: 'bzzz';
  355. yourself.
  356. scope := MethodLexicalScope new.
  357. scope addIVar: 'bzzz'.
  358. self assert: (scope bindingFor: node) isInstanceVar
  359. !
  360. testPseudoVar
  361. | node pseudoVars |
  362. pseudoVars := #('self' 'super' 'true' 'false' 'nil').
  363. pseudoVars do: [:each |
  364. node := VariableNode new
  365. value: each;
  366. yourself.
  367. self assert: (MethodLexicalScope new bindingFor: node) isPseudoVar ]
  368. !
  369. testTempVar
  370. | node scope |
  371. node := VariableNode new
  372. value: 'bzzz';
  373. yourself.
  374. scope := MethodLexicalScope new.
  375. scope addTemp: 'bzzz'.
  376. self assert: (scope bindingFor: node) isTempVar
  377. !
  378. testUnknownVar
  379. | node |
  380. node := VariableNode new
  381. value: 'bzzz';
  382. yourself.
  383. self assert: (MethodLexicalScope new bindingFor: node) isNil
  384. ! !
  385. TestCase subclass: #SemanticAnalyzerTest
  386. instanceVariableNames: 'analyzer'
  387. package: 'Compiler-Tests'!
  388. !SemanticAnalyzerTest methodsFor: 'running'!
  389. setUp
  390. analyzer := SemanticAnalyzer on: Object
  391. ! !
  392. !SemanticAnalyzerTest methodsFor: 'tests'!
  393. testAssignment
  394. | src ast |
  395. src := 'foo self := 1'.
  396. ast := smalltalk parse: src.
  397. self should: [analyzer visit: ast] raise: InvalidAssignmentError
  398. !
  399. testNonLocalReturn
  400. | src ast |
  401. src := 'foo | a | a + 1. ^ a'.
  402. ast := smalltalk parse: src.
  403. analyzer visit: ast.
  404. self deny: ast scope hasNonLocalReturn
  405. !
  406. testNonLocalReturn2
  407. | src ast |
  408. src := 'foo | a | a + 1. [ [ ^ a] ]'.
  409. ast := smalltalk parse: src.
  410. analyzer visit: ast.
  411. self assert: ast scope hasNonLocalReturn
  412. !
  413. testScope
  414. | src ast |
  415. src := 'foo | a | a + 1. [ | b | b := a ]'.
  416. ast := smalltalk parse: src.
  417. analyzer visit: ast.
  418. self deny: ast nodes first nodes last scope == ast scope.
  419. !
  420. testScope2
  421. | src ast |
  422. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  423. ast := smalltalk parse: src.
  424. analyzer visit: ast.
  425. self deny: ast nodes first nodes last nodes first nodes first scope == ast scope.
  426. !
  427. testScopeLevel
  428. | src ast |
  429. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  430. ast := smalltalk parse: src.
  431. analyzer visit: ast.
  432. self assert: ast scope scopeLevel equals: 1.
  433. self assert: ast nodes first nodes last nodes first nodes first scope scopeLevel equals: 3
  434. !
  435. testUnknownVariables
  436. | src ast |
  437. src := 'foo | a | b + a'.
  438. ast := smalltalk parse: src.
  439. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  440. !
  441. testUnknownVariablesWithScope
  442. | src ast |
  443. src := 'foo | a b | [ c + 1. [ a + 1. d + 1 ]]'.
  444. ast := smalltalk parse: src.
  445. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  446. !
  447. testVariableShadowing
  448. | src ast |
  449. src := 'foo | a | a + 1'.
  450. ast := smalltalk parse: src.
  451. analyzer visit: ast
  452. !
  453. testVariableShadowing2
  454. | src ast |
  455. src := 'foo | a | a + 1. [ | a | a := 2 ]'.
  456. ast := smalltalk parse: src.
  457. self should: [analyzer visit: ast] raise: ShadowingVariableError
  458. !
  459. testVariableShadowing3
  460. | src ast |
  461. src := 'foo | a | a + 1. [ | b | b := 2 ]'.
  462. ast := smalltalk parse: src.
  463. analyzer visit: ast
  464. !
  465. testVariableShadowing4
  466. | src ast |
  467. src := 'foo | a | a + 1. [ [ [ | b | b := 2 ] ] ]'.
  468. ast := smalltalk parse: src.
  469. analyzer visit: ast
  470. !
  471. testVariableShadowing5
  472. | src ast |
  473. src := 'foo | a | a + 1. [ [ [ | a | a := 2 ] ] ]'.
  474. ast := smalltalk parse: src.
  475. self should: [analyzer visit: ast] raise: ShadowingVariableError
  476. !
  477. testVariablesLookup
  478. | src ast |
  479. src := 'foo | a | a + 1. [ | b | b := a ]'.
  480. ast := smalltalk parse: src.
  481. analyzer visit: ast.
  482. "Binding for `a` in the message send"
  483. self assert: ast nodes first nodes first receiver binding isTempVar.
  484. self assert: ast nodes first nodes first receiver binding scope == ast scope.
  485. "Binding for `b`"
  486. self assert: ast nodes first nodes last nodes first nodes first left binding isTempVar.
  487. self assert: ast nodes first nodes last nodes first nodes first left binding scope == ast nodes first nodes last scope.
  488. ! !