1
0

Compiler-Tests.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622
  1. Smalltalk current createPackage: 'Compiler-Tests' properties: #{}!
  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. testNestedIfTrue
  260. self should: 'foo ^ true ifTrue: [ false ifFalse: [ 1 ] ]' return: 1.
  261. self should: 'foo ^ true ifTrue: [ false ifTrue: [ 1 ] ]' return: nil.
  262. self should: 'foo true ifTrue: [ false ifFalse: [ ^ 1 ] ]' return: 1.
  263. self should: 'foo true ifTrue: [ false ifTrue: [ ^ 1 ] ]' return: receiver.
  264. !
  265. testNonLocalReturn
  266. self should: 'foo [ ^ 1 ] value' return: 1.
  267. self should: 'foo [ ^ 1 + 1 ] value' return: 2.
  268. self should: 'foo | a b | a := 1. b := 2. [ ^ a + b ] value. self halt' return: 3.
  269. self should: 'foo [ :x | ^ x + x ] value: 4. ^ 2' return: 8
  270. !
  271. testSendReceiverAndArgumentsOrdered
  272. self should: 'foo
  273. | x |
  274. x := 1.
  275. ^ Array with: x with: (true ifTrue: [ x := 2 ])
  276. ' return: #(1 2).
  277. self should: 'foo
  278. | x |
  279. x := Array.
  280. ^ x with: x with: (true ifTrue: [ x := 2 ])
  281. ' return: {Array. 2}.
  282. !
  283. testifFalse
  284. self should: 'foo true ifFalse: [ ^ 1 ]' return: receiver.
  285. self should: 'foo false ifFalse: [ ^ 2 ]' return: 2.
  286. self should: 'foo ^ true ifFalse: [ 1 ]' return: nil.
  287. self should: 'foo ^ false ifFalse: [ 2 ]' return: 2.
  288. !
  289. testifFalseIfTrue
  290. self should: 'foo true ifFalse: [ ^ 1 ] ifTrue: [ ^ 2 ]' return: 2.
  291. self should: 'foo false ifFalse: [ ^ 2 ] ifTrue: [ ^1 ]' return: 2.
  292. self should: 'foo ^ true ifFalse: [ 1 ] ifTrue: [ 2 ]' return: 2.
  293. self should: 'foo ^ false ifFalse: [ 2 ] ifTrue: [ 1 ]' return: 2.
  294. !
  295. testifNil
  296. self should: 'foo ^ 1 ifNil: [ 2 ]' return: 1.
  297. self should: 'foo ^ nil ifNil: [ 2 ]' return: 2.
  298. self should: 'foo 1 ifNil: [ ^ 2 ]' return: receiver.
  299. self should: 'foo nil ifNil: [ ^ 2 ]' return: 2.
  300. !
  301. testifNilIfNotNil
  302. self should: 'foo ^ 1 ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 3.
  303. self should: 'foo ^ nil ifNil: [ 2 ] ifNotNil: [ 3 ]' return: 2.
  304. self should: 'foo 1 ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 3.
  305. self should: 'foo nil ifNil: [ ^ 2 ] ifNotNil: [ ^3 ]' return: 2.
  306. !
  307. testifNotNil
  308. self should: 'foo ^ 1 ifNotNil: [ 2 ]' return: 2.
  309. self should: 'foo ^ nil ifNotNil: [ 2 ]' return: nil.
  310. self should: 'foo 1 ifNotNil: [ ^ 2 ]' return: 2.
  311. self should: 'foo nil ifNotNil: [ ^ 2 ]' return: receiver.
  312. !
  313. testifTrue
  314. self should: 'foo false ifTrue: [ ^ 1 ]' return: receiver.
  315. self should: 'foo true ifTrue: [ ^ 2 ]' return: 2.
  316. self should: 'foo ^ false ifTrue: [ 1 ]' return: nil.
  317. self should: 'foo ^ true ifTrue: [ 2 ]' return: 2.
  318. !
  319. testifTrueIfFalse
  320. self should: 'foo false ifTrue: [ ^ 1 ] ifFalse: [ ^2 ]' return: 2.
  321. self should: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ ^ 2 ]' return: 1.
  322. self should: 'foo ^ false ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 1.
  323. self should: 'foo ^ true ifTrue: [ 2 ] ifFalse: [ 1 ]' return: 2.
  324. ! !
  325. CodeGeneratorTest subclass: #InliningCodeGeneratorTest
  326. instanceVariableNames: ''
  327. package: 'Compiler-Tests'!
  328. !InliningCodeGeneratorTest methodsFor: 'accessing'!
  329. codeGeneratorClass
  330. ^ InliningCodeGenerator
  331. ! !
  332. TestCase subclass: #ScopeVarTest
  333. instanceVariableNames: ''
  334. package: 'Compiler-Tests'!
  335. !ScopeVarTest methodsFor: 'tests'!
  336. testClassRefVar
  337. | node |
  338. node := ClassReferenceNode new
  339. value: 'Object';
  340. yourself.
  341. SemanticAnalyzer new visit: node.
  342. self assert: node binding isClassRefVar
  343. !
  344. testInstanceVar
  345. | node scope |
  346. node := VariableNode new
  347. value: 'bzzz';
  348. yourself.
  349. scope := MethodLexicalScope new.
  350. scope addIVar: 'bzzz'.
  351. self assert: (scope bindingFor: node) isInstanceVar
  352. !
  353. testPseudoVar
  354. | node pseudoVars |
  355. pseudoVars := #('self' 'super' 'true' 'false' 'nil').
  356. pseudoVars do: [:each |
  357. node := VariableNode new
  358. value: each;
  359. yourself.
  360. self assert: (MethodLexicalScope new bindingFor: node) isPseudoVar ]
  361. !
  362. testTempVar
  363. | node scope |
  364. node := VariableNode new
  365. value: 'bzzz';
  366. yourself.
  367. scope := MethodLexicalScope new.
  368. scope addTemp: 'bzzz'.
  369. self assert: (scope bindingFor: node) isTempVar
  370. !
  371. testUnknownVar
  372. | node |
  373. node := VariableNode new
  374. value: 'bzzz';
  375. yourself.
  376. self assert: (MethodLexicalScope new bindingFor: node) isNil
  377. ! !
  378. TestCase subclass: #SemanticAnalyzerTest
  379. instanceVariableNames: 'analyzer'
  380. package: 'Compiler-Tests'!
  381. !SemanticAnalyzerTest methodsFor: 'running'!
  382. setUp
  383. analyzer := SemanticAnalyzer on: Object
  384. ! !
  385. !SemanticAnalyzerTest methodsFor: 'tests'!
  386. testAssignment
  387. | src ast |
  388. src := 'foo self := 1'.
  389. ast := smalltalk parse: src.
  390. self should: [analyzer visit: ast] raise: InvalidAssignmentError
  391. !
  392. testNonLocalReturn
  393. | src ast |
  394. src := 'foo | a | a + 1. ^ a'.
  395. ast := smalltalk parse: src.
  396. analyzer visit: ast.
  397. self deny: ast scope hasNonLocalReturn
  398. !
  399. testNonLocalReturn2
  400. | src ast |
  401. src := 'foo | a | a + 1. [ [ ^ a] ]'.
  402. ast := smalltalk parse: src.
  403. analyzer visit: ast.
  404. self assert: ast scope hasNonLocalReturn
  405. !
  406. testScope
  407. | src ast |
  408. src := 'foo | a | a + 1. [ | b | b := a ]'.
  409. ast := smalltalk parse: src.
  410. analyzer visit: ast.
  411. self deny: ast nodes first nodes last scope == ast scope.
  412. !
  413. testScope2
  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 nodes first nodes first scope == ast scope.
  419. !
  420. testScopeLevel
  421. | src ast |
  422. src := 'foo | a | a + 1. [ [ | b | b := a ] ]'.
  423. ast := smalltalk parse: src.
  424. analyzer visit: ast.
  425. self assert: ast scope scopeLevel equals: 1.
  426. self assert: ast nodes first nodes last nodes first nodes first scope scopeLevel equals: 3
  427. !
  428. testUnknownVariables
  429. | src ast |
  430. src := 'foo | a | b + a'.
  431. ast := smalltalk parse: src.
  432. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  433. !
  434. testUnknownVariablesWithScope
  435. | src ast |
  436. src := 'foo | a b | [ c + 1. [ a + 1. d + 1 ]]'.
  437. ast := smalltalk parse: src.
  438. self should: [ analyzer visit: ast ] raise: UnknownVariableError
  439. !
  440. testVariableShadowing
  441. | src ast |
  442. src := 'foo | a | a + 1'.
  443. ast := smalltalk parse: src.
  444. analyzer visit: ast
  445. !
  446. testVariableShadowing2
  447. | src ast |
  448. src := 'foo | a | a + 1. [ | a | a := 2 ]'.
  449. ast := smalltalk parse: src.
  450. self should: [analyzer visit: ast] raise: ShadowingVariableError
  451. !
  452. testVariableShadowing3
  453. | src ast |
  454. src := 'foo | a | a + 1. [ | b | b := 2 ]'.
  455. ast := smalltalk parse: src.
  456. analyzer visit: ast
  457. !
  458. testVariableShadowing4
  459. | src ast |
  460. src := 'foo | a | a + 1. [ [ [ | b | b := 2 ] ] ]'.
  461. ast := smalltalk parse: src.
  462. analyzer visit: ast
  463. !
  464. testVariableShadowing5
  465. | src ast |
  466. src := 'foo | a | a + 1. [ [ [ | a | a := 2 ] ] ]'.
  467. ast := smalltalk parse: src.
  468. self should: [analyzer visit: ast] raise: ShadowingVariableError
  469. !
  470. testVariablesLookup
  471. | src ast |
  472. src := 'foo | a | a + 1. [ | b | b := a ]'.
  473. ast := smalltalk parse: src.
  474. analyzer visit: ast.
  475. "Binding for `a` in the message send"
  476. self assert: ast nodes first nodes first receiver binding isTempVar.
  477. self assert: ast nodes first nodes first receiver binding scope == ast scope.
  478. "Binding for `b`"
  479. self assert: ast nodes first nodes last nodes first nodes first left binding isTempVar.
  480. self assert: ast nodes first nodes last nodes first nodes first left binding scope == ast nodes first nodes last scope.
  481. ! !