2
0

Compiler-Tests.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659
  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. testThisContext
  109. self assert: (self interpret: 'foo ^ thisContext') outerContext isNil.
  110. self assert: (self interpret: 'foo ^ [ thisContext ] value') outerContext notNil.
  111. self assert: (self interpret: 'foo ^ [ thisContext ] value outerContext == thisContext')
  112. ! !
  113. AbstractASTInterpreterTest subclass: #ASTSteppingInterpreterTest
  114. instanceVariableNames: 'interpreter'
  115. package: 'Compiler-Tests'!
  116. !ASTSteppingInterpreterTest methodsFor: 'accessing'!
  117. interpreter
  118. ^ interpreter ifNil: [ interpreter := ASTSteppingInterpreter new ]
  119. ! !
  120. !ASTSteppingInterpreterTest methodsFor: 'tests'!
  121. testAtEnd
  122. self interpret: 'foo 1 + 2'.
  123. self deny: self interpreter atEnd.
  124. self interpreter step.
  125. self deny: self interpreter atEnd.
  126. self interpreter step.
  127. self deny: self interpreter atEnd.
  128. self interpreter step.
  129. self deny: self interpreter atEnd.
  130. self interpreter step.
  131. self assert: self interpreter atEnd
  132. !
  133. testMessageSend
  134. self interpret: 'foo 1 + 2'.
  135. "SequenceNode"
  136. self interpreter step.
  137. "SendNode"
  138. self interpreter step.
  139. "ValueNode"
  140. self interpreter step.
  141. self assert: self interpreter currentNode value equals: 1.
  142. "ValueNode"
  143. self interpreter step.
  144. self assert: self interpreter currentNode value equals: 2.
  145. "Result"
  146. self interpreter step.
  147. self assert: self interpreter result equals: 3
  148. !
  149. testSimpleStepping
  150. self interpret: 'foo 1'.
  151. "SequenceNode"
  152. self interpreter step.
  153. self assert: self interpreter result isNil.
  154. "ValueNode"
  155. self interpreter step.
  156. self assert: self interpreter result equals: 1
  157. ! !
  158. TestCase subclass: #CodeGeneratorTest
  159. instanceVariableNames: 'receiver'
  160. package: 'Compiler-Tests'!
  161. !CodeGeneratorTest methodsFor: 'accessing'!
  162. codeGeneratorClass
  163. ^ CodeGenerator
  164. !
  165. targetClass
  166. ^ DoIt
  167. ! !
  168. !CodeGeneratorTest methodsFor: 'factory'!
  169. compiler
  170. ^ Compiler new
  171. codeGeneratorClass: self codeGeneratorClass;
  172. yourself
  173. ! !
  174. !CodeGeneratorTest methodsFor: 'initialization'!
  175. setUp
  176. receiver := self targetClass new
  177. !
  178. tearDown
  179. "receiver := nil"
  180. ! !
  181. !CodeGeneratorTest methodsFor: 'testing'!
  182. should: aString return: anObject
  183. | method result |
  184. method := self compiler install: aString forClass: self targetClass category: 'tests'.
  185. result := receiver perform: method selector.
  186. self targetClass removeCompiledMethod: method.
  187. self assert: anObject equals: result
  188. ! !
  189. !CodeGeneratorTest methodsFor: 'tests'!
  190. testAssignment
  191. self should: 'foo | a | a := true ifTrue: [ 1 ]. ^ a' return: 1.
  192. self should: 'foo | a | a := false ifTrue: [ 1 ]. ^ a' return: nil.
  193. self should: 'foo | a | ^ a := true ifTrue: [ 1 ]' return: 1
  194. !
  195. testBackslashSelectors
  196. self should: '\ arg ^ 4' return: 4.
  197. self should: '\\ arg ^ 42' return: 42
  198. !
  199. testBlockReturn
  200. self should: 'foo ^ #(1 2 3) collect: [ :each | true ifTrue: [ each + 1 ] ]' return: #(2 3 4).
  201. self should: 'foo ^ #(1 2 3) collect: [ :each | false ifFalse: [ each + 1 ] ]' return: #(2 3 4).
  202. self should: 'foo ^ #(1 2 3) collect: [ :each | each odd ifTrue: [ each + 1 ] ifFalse: [ each - 1 ] ]' return: #(2 1 4).
  203. !
  204. testCascades
  205. self should: 'foo ^ Array new add: 3; add: 4; yourself' return: #(3 4)
  206. !
  207. testDynamicArrayElementsOrdered
  208. self should: 'foo
  209. | x |
  210. x := 1.
  211. ^ { x. true ifTrue: [ x := 2 ] }
  212. ' return: #(1 2).
  213. !
  214. testDynamicDictionaryElementsOrdered
  215. self should: 'foo
  216. | x |
  217. x := ''foo''->1.
  218. ^ #{ x. (true ifTrue: [ x := ''bar''->2 ]) }
  219. ' return: #{'foo'->1. 'bar'->2}.
  220. !
  221. testInnerTemporalDependentElementsOrdered
  222. self should: 'foo
  223. | x |
  224. x := Array.
  225. ^ x with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  226. ' return: {'foo'->Array. 'bar'->2}.
  227. self should: 'foo
  228. | x |
  229. x := 1.
  230. ^ Array with: ''foo''->x with: ''bar''->(true ifTrue: [ x := 2 ])
  231. ' return: {'foo'->1. 'bar'->2}.
  232. self should: 'foo
  233. | x |
  234. x := 1.
  235. ^ { ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  236. ' return: {'foo'->1. 'bar'->2}.
  237. self should: 'foo
  238. | x |
  239. x := 1.
  240. ^ #{ ''foo''->x. ''bar''->(true ifTrue: [ x := 2 ]) }
  241. ' return: #{'foo'->1. 'bar'->2}.
  242. !
  243. testLiterals
  244. self should: 'foo ^ 1' return: 1.
  245. self should: 'foo ^ ''hello''' return: 'hello'.
  246. self should: 'foo ^ #(1 2 3 4)' return: #(1 2 3 4).
  247. self should: 'foo ^ {1. [:x | x ] value: 2. 3. [4] value}' return: #(1 2 3 4).
  248. self should: 'foo ^ true' return: true.
  249. self should: 'foo ^ false' return: false.
  250. self should: 'foo ^ #{1->2. 3->4}' return: #{1->2. 3->4}.
  251. self should: 'foo ^ #hello' return: #hello.
  252. self should: 'foo ^ -123.456' return: -123.456
  253. !
  254. testLocalReturn
  255. self should: 'foo ^ 1' return: 1.
  256. self should: 'foo ^ 1 + 1' return: 2.
  257. self should: 'foo ' return: receiver.
  258. self should: 'foo self asString' return: receiver.
  259. self should: 'foo | a b | a := 1. b := 2. ^ a + b' return: 3
  260. !
  261. testMessageSends
  262. self should: 'foo ^ 1 asString' return: '1'.
  263. self should: 'foo ^ 1 + 1' return: 2.
  264. self should: 'foo ^ 1 + 2 * 3' return: 9.
  265. self should: 'foo ^ 1 to: 3' return: #(1 2 3).
  266. self should: 'foo ^ 1 to: 5 by: 2' return: #(1 3 5)
  267. !
  268. testMutableLiterals
  269. "Mutable literals must be aliased in cascades.
  270. See https://github.com/amber-smalltalk/amber/issues/428"
  271. self
  272. should: 'foo ^ #( 1 2 ) at: 1 put: 3; yourself'
  273. return: #(3 2)
  274. !
  275. testNestedIfTrue
  276. self should: 'foo ^ true ifTrue: [ false ifFalse: [ 1 ] ]' return: 1.
  277. self should: 'foo ^ true ifTrue: [ false ifTrue: [ 1 ] ]' return: nil.
  278. self should: 'foo true ifTrue: [ false ifFalse: [ ^ 1 ] ]' return: 1.
  279. self should: 'foo true ifTrue: [ false ifTrue: [ ^ 1 ] ]' return: receiver.
  280. !
  281. testNonLocalReturn
  282. self should: 'foo [ ^ 1 ] value' return: 1.
  283. self should: 'foo [ ^ 1 + 1 ] value' return: 2.
  284. self should: 'foo | a b | a := 1. b := 2. [ ^ a + b ] value. self halt' return: 3.
  285. self should: 'foo [ :x | ^ x + x ] value: 4. ^ 2' return: 8
  286. !
  287. testPascalCaseGlobal
  288. self should: 'foo ^Object' return: (smalltalk at: 'Object').
  289. self should: 'foo ^NonExistent' return: nil
  290. !
  291. testSendReceiverAndArgumentsOrdered
  292. self should: 'foo
  293. | x |
  294. x := 1.
  295. ^ Array with: x with: (true ifTrue: [ x := 2 ])
  296. ' return: #(1 2).
  297. self should: 'foo
  298. | x |
  299. x := Array.
  300. ^ x with: x with: (true ifTrue: [ x := 2 ])
  301. ' return: {Array. 2}.
  302. !
  303. testifFalse
  304. self should: 'foo true ifFalse: [ ^ 1 ]' return: receiver.
  305. self should: 'foo false ifFalse: [ ^ 2 ]' return: 2.
  306. self should: 'foo ^ true ifFalse: [ 1 ]' return: nil.
  307. self should: 'foo ^ false ifFalse: [ 2 ]' return: 2.
  308. !
  309. testifFalseIfTrue
  310. self should: 'foo true ifFalse: [ ^ 1 ] ifTrue: [ ^ 2 ]' return: 2.
  311. self should: 'foo false ifFalse: [ ^ 2 ] ifTrue: [ ^1 ]' return: 2.
  312. self should: 'foo ^ true ifFalse: [ 1 ] ifTrue: [ 2 ]' return: 2.
  313. self should: 'foo ^ false ifFalse: [ 2 ] ifTrue: [ 1 ]' return: 2.
  314. !
  315. testifNil
  316. self should: 'foo ^ 1 ifNil: [ 2 ]' return: 1.
  317. self should: 'foo ^ nil ifNil: [ 2 ]' return: 2.
  318. self should: 'foo 1 ifNil: [ ^ 2 ]' return: receiver.
  319. self should: 'foo nil ifNil: [ ^ 2 ]' return: 2.
  320. !
  321. testifNilIfNotNil
  322. self should: 'foo ^ 1 ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 3.
  323. self should: 'foo ^ nil ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 2.
  324. self should: 'foo 1 ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 3.
  325. self should: 'foo nil ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 2.
  326. !
  327. testifNotNil
  328. self should: 'foo ^ 1 ifNotNil: [ 2 ]' return: 2.
  329. self should: 'foo ^ nil ifNotNil: [ 2 ]' return: nil.
  330. self should: 'foo 1 ifNotNil: [ ^ 2 ]' return: 2.
  331. self should: 'foo nil ifNotNil: [ ^ 2 ]' return: receiver.
  332. !
  333. testifNotNilWithArgument
  334. self should: 'foo ^ 1 ifNotNil: [ :val | val + 2 ]' return: 3.
  335. self should: 'foo ^ nil ifNotNil: [ :val | val + 2 ]' return: nil.
  336. self should: 'foo ^ 1 ifNil: [ 5 ] ifNotNil: [ :val | val + 2 ]' return: 3.
  337. self should: 'foo ^ nil ifNil: [ 5 ] ifNotNil: [ :val | val + 2 ]' return: 5.
  338. self should: 'foo ^ 1 ifNotNil: [ :val | val + 2 ] ifNil: [ 5 ]' return: 3.
  339. self should: 'foo ^ nil ifNotNil: [ :val | val + 2 ] ifNil: [ 5 ]' return: 5
  340. !
  341. testifTrue
  342. self should: 'foo false ifTrue: [ ^ 1 ]' return: receiver.
  343. self should: 'foo true ifTrue: [ ^ 2 ]' return: 2.
  344. self should: 'foo ^ false ifTrue: [ 1 ]' return: nil.
  345. self should: 'foo ^ true ifTrue: [ 2 ]' return: 2.
  346. !
  347. testifTrueIfFalse
  348. self should: 'foo false ifTrue: [ ^ 1 ] ifFalse: [ ^2 ]' return: 2.
  349. self should: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ ^ 2 ]' return: 1.
  350. self should: 'foo ^ false ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 1.
  351. self should: 'foo ^ true ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 2.
  352. ! !
  353. CodeGeneratorTest subclass: #InliningCodeGeneratorTest
  354. instanceVariableNames: ''
  355. package: 'Compiler-Tests'!
  356. !InliningCodeGeneratorTest methodsFor: 'accessing'!
  357. codeGeneratorClass
  358. ^ InliningCodeGenerator
  359. ! !
  360. TestCase subclass: #ScopeVarTest
  361. instanceVariableNames: ''
  362. package: 'Compiler-Tests'!
  363. !ScopeVarTest methodsFor: 'tests'!
  364. testClassRefVar
  365. | node |
  366. node := ClassReferenceNode new
  367. value: 'Object';
  368. yourself.
  369. SemanticAnalyzer new visit: node.
  370. self assert: node binding isClassRefVar
  371. !
  372. testInstanceVar
  373. | node scope |
  374. node := VariableNode new
  375. value: 'bzzz';
  376. yourself.
  377. scope := MethodLexicalScope new.
  378. scope addIVar: 'bzzz'.
  379. self assert: (scope bindingFor: node) isInstanceVar
  380. !
  381. testPseudoVar
  382. | node pseudoVars |
  383. pseudoVars := #('self' 'super' 'true' 'false' 'nil').
  384. pseudoVars do: [:each |
  385. node := VariableNode new
  386. value: each;
  387. yourself.
  388. self assert: (MethodLexicalScope new bindingFor: node) isPseudoVar ]
  389. !
  390. testTempVar
  391. | node scope |
  392. node := VariableNode new
  393. value: 'bzzz';
  394. yourself.
  395. scope := MethodLexicalScope new.
  396. scope addTemp: 'bzzz'.
  397. self assert: (scope bindingFor: node) isTempVar
  398. !
  399. testUnknownVar
  400. | node |
  401. node := VariableNode new
  402. value: 'bzzz';
  403. yourself.
  404. self assert: (MethodLexicalScope new bindingFor: node) isNil
  405. ! !
  406. TestCase subclass: #SemanticAnalyzerTest
  407. instanceVariableNames: 'analyzer'
  408. package: 'Compiler-Tests'!
  409. !SemanticAnalyzerTest methodsFor: 'running'!
  410. setUp
  411. analyzer := SemanticAnalyzer on: Object
  412. ! !
  413. !SemanticAnalyzerTest methodsFor: 'tests'!
  414. testAssignment
  415. | src ast |
  416. src := 'foo self := 1'.
  417. ast := smalltalk parse: src.
  418. self should: [analyzer visit: ast] raise: InvalidAssignmentError
  419. !
  420. testNonLocalReturn
  421. | src ast |
  422. src := 'foo | a | a + 1. ^ a'.
  423. ast := smalltalk parse: src.
  424. analyzer visit: ast.
  425. self deny: ast scope hasNonLocalReturn
  426. !
  427. testNonLocalReturn2
  428. | src ast |
  429. src := 'foo | a | a + 1. [ [ ^ a] ]'.
  430. ast := smalltalk parse: src.
  431. analyzer visit: ast.
  432. self assert: ast scope hasNonLocalReturn
  433. !
  434. testScope
  435. | src ast |
  436. src := 'foo | a | a + 1. [ | b | b := a ]'.
  437. ast := smalltalk parse: src.
  438. analyzer visit: ast.
  439. self deny: ast nodes first nodes last scope == ast scope.
  440. !
  441. testScope2
  442. | src ast |
  443. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  444. ast := smalltalk parse: src.
  445. analyzer visit: ast.
  446. self deny: ast nodes first nodes last nodes first nodes first scope == ast scope.
  447. !
  448. testScopeLevel
  449. | src ast |
  450. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  451. ast := smalltalk parse: src.
  452. analyzer visit: ast.
  453. self assert: ast scope scopeLevel equals: 1.
  454. self assert: ast nodes first nodes last nodes first nodes first scope scopeLevel equals: 3
  455. !
  456. testUnknownVariables
  457. | src ast |
  458. src := 'foo | a | b + a'.
  459. ast := smalltalk parse: src.
  460. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  461. !
  462. testUnknownVariablesWithScope
  463. | src ast |
  464. src := 'foo | a b | [ c + 1. [ a + 1. d + 1 ]]'.
  465. ast := smalltalk parse: src.
  466. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  467. !
  468. testVariableShadowing
  469. | src ast |
  470. src := 'foo | a | a + 1'.
  471. ast := smalltalk parse: src.
  472. analyzer visit: ast
  473. !
  474. testVariableShadowing2
  475. | src ast |
  476. src := 'foo | a | a + 1. [ | a | a := 2 ]'.
  477. ast := smalltalk parse: src.
  478. self should: [analyzer visit: ast] raise: ShadowingVariableError
  479. !
  480. testVariableShadowing3
  481. | src ast |
  482. src := 'foo | a | a + 1. [ | b | b := 2 ]'.
  483. ast := smalltalk parse: src.
  484. analyzer visit: ast
  485. !
  486. testVariableShadowing4
  487. | src ast |
  488. src := 'foo | a | a + 1. [ [ [ | b | b := 2 ] ] ]'.
  489. ast := smalltalk parse: src.
  490. analyzer visit: ast
  491. !
  492. testVariableShadowing5
  493. | src ast |
  494. src := 'foo | a | a + 1. [ [ [ | a | a := 2 ] ] ]'.
  495. ast := smalltalk parse: src.
  496. self should: [analyzer visit: ast] raise: ShadowingVariableError
  497. !
  498. testVariablesLookup
  499. | src ast |
  500. src := 'foo | a | a + 1. [ | b | b := a ]'.
  501. ast := smalltalk parse: src.
  502. analyzer visit: ast.
  503. "Binding for `a` in the message send"
  504. self assert: ast nodes first nodes first receiver binding isTempVar.
  505. self assert: ast nodes first nodes first receiver binding scope == ast scope.
  506. "Binding for `b`"
  507. self assert: ast nodes first nodes last nodes first nodes first left binding isTempVar.
  508. self assert: ast nodes first nodes last nodes first nodes first left binding scope == ast nodes first nodes last scope.
  509. ! !