1
0

Compiler-Tests.st 9.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471
  1. Smalltalk current createPackage: 'Compiler-Tests' properties: #{}!
  2. TestCase subclass: #ImporterTest
  3. instanceVariableNames: ''
  4. category: 'Compiler-Tests'!
  5. !ImporterTest methodsFor: 'private'!
  6. chunkString
  7. ^'!!Object methodsFor: ''importer test method''!!
  8. importerTestMethod
  9. ^''success''
  10. !! !!
  11. '
  12. !
  13. bigChunkString
  14. ^'Smalltalk current createPackage: ''Cypress-Definitions'' properties: #{}!!
  15. Object subclass: #CypressSnapshot
  16. instanceVariableNames: ''definitions''
  17. package: ''Cypress-Definitions''!!
  18. !!CypressSnapshot methodsFor: ''not yet classified''!!
  19. definitions: aDefinitions
  20. definitions := aDefinitions
  21. !!
  22. definitions
  23. ^definitions
  24. !! !!
  25. !!CypressSnapshot class methodsFor: ''not yet classified''!!
  26. definitions: aDefinitions
  27. ^(self new) definitions: aDefinitions
  28. !! !!
  29. Object subclass: #CypressPackage
  30. instanceVariableNames: ''name''
  31. package: ''Cypress-Definitions''!!
  32. !!CypressPackage methodsFor: ''not yet classified''!!
  33. = other
  34. ^ other species = self species and: [other name sameAs: name]
  35. !!
  36. name
  37. ^ name
  38. !!
  39. name: aString
  40. name := aString
  41. !!
  42. snapshot
  43. | package definitions name |
  44. package := Package named: self name.
  45. definitions := OrderedCollection new.
  46. package sortedClasses do: [:cls |
  47. definitions add: cls asCypressClassDefinition.
  48. cls methodDictionary values do: [:method |
  49. (method category match: ''^\*'') ifFalse: [
  50. definitions add: method asCypressMethodDefinition ]].
  51. cls class methodDictionary values do: [:method |
  52. (method category match: ''^\*'') ifFalse: [
  53. definitions add: method asCypressMethodDefinition ]]].
  54. name := package name.
  55. Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
  56. each methodDictionary values do: [:method |
  57. method category = (''*'', name) ifTrue: [
  58. definitions add: method asCypressMethodDefinition ]]].
  59. ^ CypressSnapshot definitions: definitions
  60. !!
  61. printString
  62. ^super printString, ''('', name, '')''
  63. !! !!
  64. Object subclass: #CypressDefinition
  65. instanceVariableNames: ''''
  66. package: ''Cypress-Definitions''!!
  67. !!CypressDefinition methodsFor: ''not yet classified''!!
  68. = aDefinition
  69. ^(aDefinition isKindOf: CypressDefinition) and: [self isRevisionOf: aDefinition]
  70. !!
  71. isRevisionOf: aDefinition
  72. ^ (aDefinition isKindOf: CypressDefinition) and: [aDefinition description = self description]
  73. !!
  74. description
  75. self subclassResponsibility
  76. !!
  77. isSameRevisionAs: aDefinition
  78. ^ self = aDefinition
  79. !! !!
  80. Object subclass: #CypressPatch
  81. instanceVariableNames: ''operations''
  82. package: ''Cypress-Definitions''!!
  83. !!CypressPatch methodsFor: ''not yet classified''!!
  84. fromBase: baseSnapshot toTarget: targetSnapshot
  85. | base target |
  86. operations := OrderedCollection new.
  87. base := CypressDefinitionIndex definitions: baseSnapshot definitions.
  88. target := CypressDefinitionIndex definitions: targetSnapshot definitions.
  89. target definitions do:
  90. [:t |
  91. base
  92. definitionLike: t
  93. ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (CypressModification of: b to: t)]]
  94. ifAbsent: [operations add: (CypressAddition of: t)]].
  95. base definitions do:
  96. [:b |
  97. target
  98. definitionLike: b
  99. ifPresent: [:t | ]
  100. ifAbsent: [operations add: (CypressRemoval of: b)]]
  101. !!
  102. operations
  103. ^operations
  104. !! !!
  105. !!CypressPatch class methodsFor: ''not yet classified''!!
  106. fromBase: baseSnapshot toTarget: targetSnapshot
  107. ^ (self new)
  108. fromBase: baseSnapshot
  109. toTarget: targetSnapshot
  110. !! !!
  111. Object subclass: #CypressDefinitionIndex
  112. instanceVariableNames: ''definitionMap''
  113. package: ''Cypress-Definitions''!!
  114. !!CypressDefinitionIndex methodsFor: ''not yet classified''!!
  115. add: aDefinition
  116. ^ self definitionMap at: aDefinition description put: aDefinition
  117. !!
  118. addAll: aCollection
  119. aCollection do: [:ea | self add: ea]
  120. !!
  121. definitionLike: aDefinition ifPresent: foundBlock ifAbsent: errorBlock
  122. | definition |
  123. definition := self definitionMap at: aDefinition description ifAbsent: [].
  124. ^ definition
  125. ifNil: errorBlock
  126. ifNotNil: [foundBlock value: definition]
  127. !!
  128. definitions
  129. ^self definitionMap values
  130. !!
  131. definitionMap
  132. definitionMap ifNil: [ definitionMap := Dictionary new ].
  133. ^ definitionMap
  134. !!
  135. remove: aDefinition
  136. self definitionMap removeKey: aDefinition description ifAbsent: []
  137. !! !!
  138. !!CypressDefinitionIndex class methodsFor: ''not yet classified''!!
  139. definitions: aCollection
  140. ^ self new addAll: aCollection
  141. !! !!
  142. Object subclass: #CypressPatchOperation
  143. instanceVariableNames: ''''
  144. package: ''Cypress-Definitions''!!
  145. CypressDefinition subclass: #CypressClassDefinition
  146. instanceVariableNames: ''name superclassName category comment instVarNames classInstVarNames''
  147. package: ''Cypress-Definitions''!!
  148. !!CypressClassDefinition methodsFor: ''not yet classified''!!
  149. name: aClassName superclassName: aSuperclassName category: aCategory instVarNames: anInstanceVariableNames classInstVarNames: aClassInstanceVariableNames comment: aComment
  150. name := aClassName.
  151. superclassName := aSuperclassName.
  152. category := aCategory.
  153. instVarNames := anInstanceVariableNames.
  154. classInstVarNames := aClassInstanceVariableNames.
  155. comment := aComment
  156. !!
  157. = aDefinition
  158. ^(super = aDefinition)
  159. and: [superclassName = aDefinition superclassName
  160. and: [category = aDefinition category
  161. and: [instVarNames = aDefinition instVarNames
  162. and: [classInstVarNames = aDefinition classInstVarNames
  163. and: [comment = aDefinition comment]]]]]
  164. !!
  165. superclassName
  166. ^superclassName
  167. !!
  168. name
  169. ^name
  170. !!
  171. category
  172. ^category
  173. !!
  174. comment
  175. ^comment
  176. !!
  177. description
  178. ^ Array with: name
  179. !!
  180. instVarNames
  181. ^instVarNames
  182. !!
  183. classInstVarNames
  184. ^classInstVarNames
  185. !! !!
  186. !!CypressClassDefinition class methodsFor: ''not yet classified''!!
  187. name: aClassName
  188. superclassName: aSuperclassName
  189. category: aCategory
  190. instVarNames: anInstanceVariableNames
  191. classInstVarNames: aClassInstanceVariableNames
  192. comment: aComment
  193. ^(self new)
  194. name: aClassName
  195. superclassName: aSuperclassName
  196. category: aCategory
  197. instVarNames: anInstanceVariableNames
  198. classInstVarNames: aClassInstanceVariableNames
  199. comment: aComment
  200. !! !!
  201. CypressDefinition subclass: #CypressMethodDefinition
  202. instanceVariableNames: ''classIsMeta source category selector className''
  203. package: ''Cypress-Definitions''!!
  204. !!CypressMethodDefinition methodsFor: ''not yet classified''!!
  205. className: aName classIsMeta: isMetaclass selector: aSelector category: aCategory source: aSource
  206. className := aName.
  207. classIsMeta := isMetaclass.
  208. selector := aSelector.
  209. category := aCategory.
  210. source := aSource.
  211. !!
  212. = aDefinition
  213. ^ super = aDefinition
  214. and: [ aDefinition source = self source
  215. and: [ aDefinition category = self category ] ]
  216. !!
  217. source
  218. ^source
  219. !!
  220. category
  221. ^category
  222. !!
  223. description
  224. ^ Array
  225. with: className
  226. with: selector
  227. with: classIsMeta
  228. !! !!
  229. !!CypressMethodDefinition class methodsFor: ''not yet classified''!!
  230. className: aName
  231. classIsMeta: isMetaclass
  232. selector: aSelector
  233. category: aCategory
  234. source: aSource
  235. ^(self new)
  236. className: aName
  237. classIsMeta: isMetaclass
  238. selector: aSelector
  239. category: aCategory
  240. source: aSource
  241. !! !!
  242. CypressPatchOperation subclass: #CypressAddition
  243. instanceVariableNames: ''definition''
  244. package: ''Cypress-Definitions''!!
  245. !!CypressAddition methodsFor: ''not yet classified''!!
  246. definition: aDefinition
  247. definition := aDefinition
  248. !! !!
  249. !!CypressAddition class methodsFor: ''not yet classified''!!
  250. of: aDefinition
  251. ^ self new definition: aDefinition
  252. !! !!
  253. CypressPatchOperation subclass: #CypressModification
  254. instanceVariableNames: ''obsoletion modification''
  255. package: ''Cypress-Definitions''!!
  256. !!CypressModification methodsFor: ''not yet classified''!!
  257. base: base target: target
  258. obsoletion := base.
  259. modification := target.
  260. !! !!
  261. !!CypressModification class methodsFor: ''not yet classified''!!
  262. of: base to: target
  263. ^ self new base: base target: target
  264. !! !!
  265. CypressPatchOperation subclass: #CypressRemoval
  266. instanceVariableNames: ''definition''
  267. package: ''Cypress-Definitions''!!
  268. !!CypressRemoval methodsFor: ''not yet classified''!!
  269. definition: aDefinition
  270. definition := aDefinition
  271. !! !!
  272. !!CypressRemoval class methodsFor: ''not yet classified''!!
  273. of: aDefinition
  274. ^ self new definition: aDefinition
  275. !! !!
  276. !!Object methodsFor: ''*Cypress-Definitions''!!
  277. species
  278. ^self class
  279. !! !!
  280. !!Class methodsFor: ''*Cypress-Definitions''!!
  281. asCypressClassDefinition
  282. ^CypressClassDefinition
  283. name: self name
  284. superclassName: self superclass name
  285. category: self category
  286. instVarNames: self instanceVariableNames
  287. classInstVarNames: self class instanceVariableNames
  288. comment: self comment
  289. !! !!
  290. !!CompiledMethod methodsFor: ''*Cypress-Definitions''!!
  291. asCypressMethodDefinition
  292. ^CypressMethodDefinition
  293. className: self methodClass name
  294. classIsMeta: self methodClass isMetaclass
  295. selector: self selector
  296. category: self category
  297. source: self source
  298. !! !!
  299. !!CharacterArray methodsFor: ''*Cypress-Definitions''!!
  300. sameAs: aString
  301. ^self asUppercase = aString asUppercase
  302. !! !!
  303. '
  304. ! !
  305. !ImporterTest methodsFor: 'running'!
  306. setUp
  307. super setUp.
  308. self cleanUp
  309. !
  310. tearDown
  311. super tearDown.
  312. self cleanUp
  313. !
  314. cleanUp
  315. (Object methodDictionary includesKey: #importerTestMethod)
  316. ifTrue: [ Object removeCompiledMethod: (Object methodAt: #importerTestMethod)].
  317. ! !
  318. !ImporterTest methodsFor: 'tests'!
  319. testBigChunkString
  320. "importer does not correctly add extension methods.
  321. After loading in AmberProjectImporter, the following import fails...get a MNU from `CypressPackage new species`:
  322. AmberProjectImporter
  323. importSTPackage: 'Cypress-Definitions'
  324. prefix: 'tests/'.
  325. CypressPackage new species.
  326. WARNING this guy isn't cleaned up automatically"
  327. Importer new import: self bigChunkString readStream.
  328. CypressPackage new species.
  329. !
  330. testChunkString
  331. Importer new import: self chunkString readStream.
  332. self assert: (Object methodDictionary includesKey: 'importerTestMethod').
  333. self assert: (Object new importerTestMethod = 'success').
  334. ! !
  335. !Object methodsFor: '*Compiler-Tests'!
  336. importerLoadMethod
  337. ^'success'
  338. ! !