Compiler-Tests.st 23 KB

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