Kernel-Tests.st 71 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910
  1. Smalltalk createPackage: 'Kernel-Tests'!
  2. TestCase subclass: #AnnouncementSubscriptionTest
  3. instanceVariableNames: ''
  4. package: 'Kernel-Tests'!
  5. !AnnouncementSubscriptionTest methodsFor: 'tests'!
  6. testAddExtensionMethod
  7. | method dirty |
  8. dirty := self class package isDirty.
  9. self class package beClean.
  10. method := self class compile: 'doNothing' protocol: '**not-a-package'.
  11. self deny: self class package isDirty.
  12. self class removeCompiledMethod: method.
  13. dirty ifTrue: [ self class package beDirty ]
  14. !
  15. testHandlesAnnouncement
  16. | subscription announcementClass1 announcementClass2 classBuilder |
  17. classBuilder := ClassBuilder new.
  18. announcementClass1 := classBuilder basicAddSubclassOf: SystemAnnouncement named: 'TestAnnouncement1' instanceVariableNames: #() package: 'Kernel-Tests'.
  19. subscription := AnnouncementSubscription new announcementClass: SystemAnnouncement.
  20. "Test whether the same class triggers the announcement"
  21. self assert: (subscription handlesAnnouncement: SystemAnnouncement) equals: true.
  22. "Test whether a subclass triggers the announcement"
  23. self assert: (subscription handlesAnnouncement: announcementClass1) equals: true.
  24. "Test whether an unrelated class does not trigger the announcement"
  25. self assert: (subscription handlesAnnouncement: Object) equals: false.
  26. classBuilder basicRemoveClass: announcementClass1.
  27. ! !
  28. TestCase subclass: #AnnouncerTest
  29. instanceVariableNames: ''
  30. package: 'Kernel-Tests'!
  31. !AnnouncerTest methodsFor: 'tests'!
  32. testOnDo
  33. | counter announcer |
  34. counter := 0.
  35. announcer := Announcer new.
  36. announcer on: SystemAnnouncement do: [ counter := counter + 1 ].
  37. announcer announce: (SystemAnnouncement new).
  38. self assert: counter equals: 1.
  39. announcer announce: (SystemAnnouncement new).
  40. self assert: counter equals: 2.
  41. !
  42. testOnDoFor
  43. | counter announcer |
  44. counter := 0.
  45. announcer := Announcer new.
  46. announcer on: SystemAnnouncement do: [ counter := counter + 1 ] for: self.
  47. announcer announce: (SystemAnnouncement new).
  48. self assert: counter equals: 1.
  49. announcer announce: (SystemAnnouncement new).
  50. self assert: counter equals: 2.
  51. announcer unsubscribe: self.
  52. announcer announce: (SystemAnnouncement new).
  53. self assert: counter equals: 2.
  54. !
  55. testOnDoOnce
  56. | counter announcer |
  57. counter := 0.
  58. announcer := Announcer new.
  59. announcer on: SystemAnnouncement doOnce: [ counter := counter + 1 ].
  60. announcer announce: (SystemAnnouncement new).
  61. self assert: counter equals: 1.
  62. announcer announce: (SystemAnnouncement new).
  63. self assert: counter equals: 1.
  64. ! !
  65. TestCase subclass: #BlockClosureTest
  66. instanceVariableNames: ''
  67. package: 'Kernel-Tests'!
  68. !BlockClosureTest methodsFor: 'fixture'!
  69. localReturnOnDoCatch
  70. [ ^ 2 ] on: Error do: [].
  71. ^ 3
  72. !
  73. localReturnOnDoMiss
  74. [ ^ 2 ] on: Class do: [].
  75. ^ 3
  76. ! !
  77. !BlockClosureTest methodsFor: 'tests'!
  78. testCanClearInterval
  79. self shouldnt: [ ([ Error new signal ] valueWithInterval: 0) clearInterval ] raise: Error
  80. !
  81. testCanClearTimeout
  82. self shouldnt: [ ([ Error new signal ] valueWithTimeout: 0) clearTimeout ] raise: Error
  83. !
  84. testCompiledSource
  85. self assert: ([ 1+1 ] compiledSource includesSubString: 'function')
  86. !
  87. testCurrySelf
  88. | curriedMethod array |
  89. curriedMethod := [ :selfarg :x | selfarg at: x ] currySelf asCompiledMethod: 'foo:'.
  90. array := #(3 1 4).
  91. ClassBuilder new installMethod: curriedMethod forClass: Array protocol: '**test helper'.
  92. [ self assert: (array foo: 2) equals: 1 ]
  93. ensure: [ Array removeCompiledMethod: curriedMethod ]
  94. !
  95. testEnsure
  96. self assert: ([ 3 ] ensure: [ 4 ]) equals: 3
  97. !
  98. testEnsureRaises
  99. self should: [ [Error new signal ] ensure: [ true ]] raise: Error
  100. !
  101. testExceptionSemantics
  102. "See https://lolg.it/amber/amber/issues/314"
  103. self timeout: 100.
  104. (self async: [
  105. [
  106. self assert: true.
  107. Error signal.
  108. "The following should *not* be run"
  109. self deny: true.
  110. self finished.
  111. ] on: Error do: [ :ex | self finished ]
  112. ]) valueWithTimeout: 0
  113. !
  114. testLocalReturnOnDoCatch
  115. self assert: self localReturnOnDoCatch equals: 2
  116. !
  117. testLocalReturnOnDoMiss
  118. self assert: self localReturnOnDoMiss equals: 2
  119. !
  120. testNewWithValues
  121. <inlineJS: '
  122. function TestConstructor(arg1, arg2, arg3) {}
  123. TestConstructor.prototype.name = "theTestPrototype";
  124. var wrappedConstructor = $recv(TestConstructor);
  125. var result = wrappedConstructor._newWithValues_([1, 2, 3]);
  126. self._assert_(result instanceof TestConstructor);
  127. self._assert_equals_(result.name, "theTestPrototype");
  128. /* newWithValues: cannot help if the argument list is wrong, and should warn that a mistake was made. */
  129. self._should_raise_(function () {wrappedConstructor._newWithValues_("single argument");}, $globals.Error);
  130. '>
  131. !
  132. testNumArgs
  133. self assert: [] numArgs equals: 0.
  134. self assert: [ :a :b | ] numArgs equals: 2
  135. !
  136. testOnDo
  137. self assert: ([ Error new signal ] on: Error do: [ :ex | true ])
  138. !
  139. testValue
  140. self assert: ([ 1+1 ] value) equals: 2.
  141. self assert: ([ :x | x +1 ] value: 2) equals: 3.
  142. self assert: ([ :x :y | x*y ] value: 2 value: 4) equals: 8.
  143. "Arguments are optional in Amber. This isn't ANSI compliant."
  144. self assert: ([ :a :b :c | 1 ] value) equals: 1
  145. !
  146. testValueWithPossibleArguments
  147. self assert: ([ 1 ] valueWithPossibleArguments: #(3 4)) equals: 1.
  148. self assert: ([ :a | a + 4 ] valueWithPossibleArguments: #(3 4)) equals: 7.
  149. self assert: ([ :a :b | a + b ] valueWithPossibleArguments: #(3 4 5)) equals: 7.
  150. !
  151. testWhileFalse
  152. | i |
  153. i := 0.
  154. [ i > 5 ] whileFalse: [ i := i + 1 ].
  155. self assert: i equals: 6.
  156. i := 0.
  157. [ i := i + 1. i > 5 ] whileFalse.
  158. self assert: i equals: 6
  159. !
  160. testWhileTrue
  161. | i |
  162. i := 0.
  163. [ i < 5 ] whileTrue: [ i := i + 1 ].
  164. self assert: i equals: 5.
  165. i := 0.
  166. [ i := i + 1. i < 5 ] whileTrue.
  167. self assert: i equals: 5
  168. ! !
  169. TestCase subclass: #BooleanTest
  170. instanceVariableNames: ''
  171. package: 'Kernel-Tests'!
  172. !BooleanTest methodsFor: 'tests'!
  173. testEquality
  174. "We're on top of JS...just be sure to check the basics!!"
  175. self deny: 0 = false.
  176. self deny: false = 0.
  177. self deny: '' = false.
  178. self deny: false = ''.
  179. self assert: (true = true).
  180. self deny: false = true.
  181. self deny: true = false.
  182. self assert: (false = false).
  183. "JS may do some type coercing after sending a message"
  184. self assert: (true yourself = true).
  185. self assert: (true yourself = true yourself)
  186. !
  187. testIdentity
  188. "We're on top of JS...just be sure to check the basics!!"
  189. self deny: 0 == false.
  190. self deny: false == 0.
  191. self deny: '' == false.
  192. self deny: false == ''.
  193. self assert: true == true.
  194. self deny: false == true.
  195. self deny: true == false.
  196. self assert: false == false.
  197. "JS may do some type coercing after sending a message"
  198. self assert: true yourself == true.
  199. self assert: true yourself == true yourself
  200. !
  201. testIfTrueIfFalse
  202. self assert: (true ifTrue: [ 'alternative block' ]) equals: 'alternative block'.
  203. self assert: (true ifFalse: [ 'alternative block' ]) equals: nil.
  204. self assert: (false ifTrue: [ 'alternative block' ]) equals: nil.
  205. self assert: (false ifFalse: [ 'alternative block' ]) equals: 'alternative block'.
  206. self assert: (false ifTrue: [ 'alternative block' ] ifFalse: [ 'alternative block2' ]) equals: 'alternative block2'.
  207. self assert: (false ifFalse: [ 'alternative block' ] ifTrue: [ 'alternative block2' ]) equals: 'alternative block'.
  208. self assert: (true ifTrue: [ 'alternative block' ] ifFalse: [ 'alternative block2' ]) equals: 'alternative block'.
  209. self assert: (true ifFalse: [ 'alternative block' ] ifTrue: [ 'alternative block2' ]) equals: 'alternative block2'.
  210. !
  211. testIfTrueIfFalseWithBoxing
  212. self assert: (true yourself ifTrue: [ 'alternative block' ]) equals: 'alternative block'.
  213. self assert: (true yourself ifFalse: [ 'alternative block' ]) equals: nil.
  214. self assert: (false yourself ifTrue: [ 'alternative block' ]) equals: nil.
  215. self assert: (false yourself ifFalse: [ 'alternative block' ]) equals: 'alternative block'.
  216. self assert: (false yourself ifTrue: [ 'alternative block' ] ifFalse: [ 'alternative block2' ]) equals: 'alternative block2'.
  217. self assert: (false yourself ifFalse: [ 'alternative block' ] ifTrue: [ 'alternative block2' ]) equals: 'alternative block'.
  218. self assert: (true yourself ifTrue: [ 'alternative block' ] ifFalse: [ 'alternative block2' ]) equals: 'alternative block'.
  219. self assert: (true yourself ifFalse: [ 'alternative block' ] ifTrue: [ 'alternative block2' ]) equals: 'alternative block2'.
  220. !
  221. testLogic
  222. "Trivial logic table"
  223. self assert: (true & true);
  224. deny: (true & false);
  225. deny: (false & true);
  226. deny: (false & false).
  227. self assert: (true | true);
  228. assert: (true | false);
  229. assert: (false | true);
  230. deny: (false | false).
  231. "Checking that expressions work fine too"
  232. self assert: (true & (1 > 0));
  233. deny: ((1 > 0) & false);
  234. deny: ((1 > 0) & (1 > 2)).
  235. self assert: (false | (1 > 0));
  236. assert: ((1 > 0) | false);
  237. assert: ((1 > 0) | (1 > 2))
  238. !
  239. testLogicKeywords
  240. "Trivial logic table"
  241. self
  242. assert: (true and: [ true ]);
  243. deny: (true and: [ false ]);
  244. deny: (false and: [ true ]);
  245. deny: (false and: [ false ]).
  246. self
  247. assert: (true or: [ true ]);
  248. assert: (true or: [ false ]);
  249. assert: (false or: [ true ]);
  250. deny: (false or: [ false ]).
  251. "Checking that expressions work fine too"
  252. self
  253. assert: (true and: [ 1 > 0 ]);
  254. deny: ((1 > 0) and: [ false ]);
  255. deny: ((1 > 0) and: [ 1 > 2 ]).
  256. self
  257. assert: (false or: [ 1 > 0 ]);
  258. assert: ((1 > 0) or: [ false ]);
  259. assert: ((1 > 0) or: [ 1 > 2 ])
  260. !
  261. testNonBooleanError
  262. self should: [ '' ifTrue: [] ifFalse: [] ] raise: NonBooleanReceiver
  263. ! !
  264. TestCase subclass: #ClassBuilderTest
  265. instanceVariableNames: 'builder theClass'
  266. package: 'Kernel-Tests'!
  267. !ClassBuilderTest methodsFor: 'running'!
  268. setUp
  269. builder := ClassBuilder new
  270. !
  271. tearDown
  272. theClass ifNotNil: [ Smalltalk removeClass: theClass. theClass := nil ]
  273. ! !
  274. !ClassBuilderTest methodsFor: 'tests'!
  275. testClassCopy
  276. theClass := builder copyClass: ObjectMock named: 'ObjectMock2'.
  277. self assert: theClass superclass == ObjectMock superclass.
  278. self assert: theClass instanceVariableNames == ObjectMock instanceVariableNames.
  279. self assert: theClass name equals: 'ObjectMock2'.
  280. self assert: theClass package == ObjectMock package.
  281. self assert: theClass methodDictionary keys equals: ObjectMock methodDictionary keys
  282. !
  283. testClassMigration
  284. | instance oldClass |
  285. oldClass := builder copyClass: ObjectMock named: 'ObjectMock2'.
  286. instance := (Smalltalk globals at: 'ObjectMock2') new.
  287. "Change the superclass of ObjectMock2"
  288. ObjectMock subclass: (Smalltalk globals at: 'ObjectMock2')
  289. instanceVariableNames: ''
  290. package: 'Kernel-Tests'.
  291. self deny: oldClass == ObjectMock2.
  292. self assert: ObjectMock2 superclass == ObjectMock.
  293. self assert: ObjectMock2 instanceVariableNames isEmpty.
  294. self assert: ObjectMock2 selectors equals: oldClass selectors.
  295. self assert: ObjectMock2 comment equals: oldClass comment.
  296. self assert: ObjectMock2 package name equals: 'Kernel-Tests'.
  297. self deny: instance class == ObjectMock2.
  298. "Commeting this out. Tests implementation detail."
  299. "self assert: instance class name equals: 'OldObjectMock2'."
  300. self assert: (Smalltalk globals at: instance class name) isNil.
  301. Smalltalk removeClass: ObjectMock2
  302. !
  303. testClassMigrationWithClassInstanceVariables
  304. builder copyClass: ObjectMock named: 'ObjectMock2'.
  305. ObjectMock2 class instanceVariableNames: 'foo bar'.
  306. "Change the superclass of ObjectMock2"
  307. ObjectMock subclass: (Smalltalk globals at: 'ObjectMock2')
  308. instanceVariableNames: ''
  309. package: 'Kernel-Tests'.
  310. self assert: ObjectMock2 class instanceVariableNames equals: #('foo' 'bar').
  311. Smalltalk removeClass: ObjectMock2
  312. !
  313. testClassMigrationWithSubclasses
  314. builder copyClass: ObjectMock named: 'ObjectMock2'.
  315. ObjectMock2 subclass: 'ObjectMock3' instanceVariableNames: '' package: 'Kernel-Tests'.
  316. ObjectMock3 subclass: 'ObjectMock4' instanceVariableNames: '' package: 'Kernel-Tests'.
  317. "Change the superclass of ObjectMock2"
  318. ObjectMock subclass: (Smalltalk globals at: 'ObjectMock2')
  319. instanceVariableNames: ''
  320. package: 'Kernel-Tests'.
  321. self assert: (ObjectMock subclasses includes: ObjectMock2).
  322. self assert: (ObjectMock2 subclasses includes: ObjectMock3).
  323. self assert: (ObjectMock3 subclasses includes: ObjectMock4).
  324. ObjectMock allSubclasses reverseDo: [ :each | Smalltalk removeClass: each ]
  325. !
  326. testInstanceVariableNames
  327. self assert: (builder instanceVariableNamesFor: ' hello world ') equals: #('hello' 'world')
  328. ! !
  329. TestCase subclass: #ClassTest
  330. instanceVariableNames: 'builder theClass'
  331. package: 'Kernel-Tests'!
  332. !ClassTest methodsFor: 'running'!
  333. jsConstructor
  334. <inlineJS: '
  335. function Foo(){}
  336. Foo.prototype.valueOf = function () {return 4;};
  337. return Foo;
  338. '>
  339. !
  340. setUp
  341. builder := ClassBuilder new
  342. !
  343. tearDown
  344. theClass ifNotNil: [
  345. theClass allSubclasses reverseDo: [ :each | Smalltalk removeClass: each ].
  346. Smalltalk removeClass: theClass.
  347. theClass := nil ]
  348. !
  349. trickyJsConstructor
  350. <inlineJS: '
  351. function Foo(){}
  352. Foo.prototype.valueOf = function () {return 4;};
  353. Foo.prototype._foo = function () {return "bar";};
  354. return Foo;
  355. '>
  356. ! !
  357. !ClassTest methodsFor: 'tests'!
  358. testAllSubclasses
  359. | subclasses index |
  360. subclasses := Object subclasses.
  361. index := 1.
  362. [ index > subclasses size ]
  363. whileFalse: [ subclasses addAll: (subclasses at: index) subclasses.
  364. index := index + 1 ].
  365. self assert: Object allSubclasses equals: subclasses
  366. !
  367. testMetaclassSubclasses
  368. | subclasses |
  369. subclasses := (Object class instanceClass subclasses
  370. select: [ :each | each isMetaclass not ])
  371. collect: [ :each | each theMetaClass ].
  372. self assert: Object class subclasses equals: subclasses
  373. !
  374. testSetJavaScriptConstructor
  375. | instance |
  376. theClass := builder copyClass: ObjectMock named: 'ObjectMock2'.
  377. theClass javascriptConstructor: self jsConstructor.
  378. "part took from copy class test"
  379. self assert: theClass superclass == ObjectMock superclass.
  380. self assert: theClass instanceVariableNames == ObjectMock instanceVariableNames.
  381. self assert: theClass name equals: 'ObjectMock2'.
  382. self assert: theClass package == ObjectMock package.
  383. self assert: theClass methodDictionary keys equals: ObjectMock methodDictionary keys.
  384. "testing specific to late-coupled detached root class"
  385. instance := theClass new.
  386. self assert: instance class == theClass.
  387. self assert: instance value equals: 4.
  388. self shouldnt: [ instance foo: 9 ] raise: Error.
  389. self assert: instance foo equals: 9
  390. !
  391. testTrickySetJavaScriptConstructor
  392. | instance |
  393. theClass := builder copyClass: ObjectMock named: 'ObjectMock2'.
  394. theClass javascriptConstructor: self trickyJsConstructor.
  395. "part took from copy class test"
  396. self assert: theClass superclass == ObjectMock superclass.
  397. self assert: theClass instanceVariableNames == ObjectMock instanceVariableNames.
  398. self assert: theClass name equals: 'ObjectMock2'.
  399. self assert: theClass package == ObjectMock package.
  400. self assert: theClass methodDictionary keys equals: ObjectMock methodDictionary keys.
  401. "testing specific to late-coupled detached root class"
  402. instance := theClass new.
  403. self assert: instance class == theClass.
  404. self assert: instance value equals: 4.
  405. self shouldnt: [ instance foo: 9 ] raise: Error.
  406. self assert: instance foo equals: 9
  407. ! !
  408. TestCase subclass: #CollectionTest
  409. instanceVariableNames: 'sampleBlock'
  410. package: 'Kernel-Tests'!
  411. !CollectionTest methodsFor: 'convenience'!
  412. assertSameContents: aCollection as: anotherCollection
  413. self assert: (aCollection size = anotherCollection size).
  414. aCollection do: [ :each |
  415. self assert: ((aCollection occurrencesOf: each) = (anotherCollection occurrencesOf: each)) ]
  416. ! !
  417. !CollectionTest methodsFor: 'fixture'!
  418. collection
  419. "Answers pre-filled collection of type tested."
  420. self subclassResponsibility
  421. !
  422. collectionClass
  423. "Answers class of collection type tested"
  424. ^ self class collectionClass
  425. !
  426. collectionOfPrintStrings
  427. "Answers self collection but with values
  428. changed to their printStrings"
  429. self subclassResponsibility
  430. !
  431. collectionSize
  432. "Answers size of self collection."
  433. self subclassResponsibility
  434. !
  435. collectionWithDuplicates
  436. "Answers pre-filled collection of type tested,
  437. with exactly five distinct elements,
  438. some of them appearing multiple times, if possible."
  439. self subclassResponsibility
  440. !
  441. collectionWithNewValue
  442. "Answers a collection which shows how
  443. self collection would look after adding
  444. self sampleNewValue"
  445. self subclassResponsibility
  446. !
  447. sampleNewValue
  448. "Answers a value that is not yet there
  449. and can be put into a tested collection"
  450. ^ 'N'
  451. !
  452. sampleNewValueAsCollection
  453. "Answers self sampleNewValue
  454. wrapped in single element collection
  455. of tested type"
  456. ^ self collectionClass with: self sampleNewValue
  457. ! !
  458. !CollectionTest methodsFor: 'initialization'!
  459. initialize
  460. super initialize.
  461. sampleBlock := []
  462. ! !
  463. !CollectionTest methodsFor: 'testing'!
  464. isCollectionReadOnly
  465. ^ false
  466. ! !
  467. !CollectionTest methodsFor: 'tests'!
  468. testAddAll
  469. self assert: (self collection addAll: self collectionClass new; yourself) equals: self collection.
  470. self assert: (self collectionClass new addAll: self collection; yourself) equals: self collection.
  471. self assert: (self collectionClass new addAll: self collectionClass new; yourself) equals: self collectionClass new.
  472. self assert: (self collection addAll: self sampleNewValueAsCollection; yourself) equals: self collectionWithNewValue.
  473. self assertSameContents: (self sampleNewValueAsCollection addAll: self collection; yourself) as: self collectionWithNewValue
  474. !
  475. testAllSatisfy
  476. | collection anyOne |
  477. collection := self collection.
  478. anyOne := collection anyOne.
  479. self assert: (collection allSatisfy: [ :each | collection includes: each ]).
  480. self deny: (collection allSatisfy: [ :each | each ~= anyOne ])
  481. !
  482. testAnyOne
  483. self should: [ self collectionClass new anyOne ] raise: Error.
  484. self assert: (self collection includes: self collection anyOne)
  485. !
  486. testAnySatisfy
  487. | anyOne |
  488. anyOne := self collection anyOne.
  489. self assert: (self collection anySatisfy: [ :each | each = anyOne ]).
  490. self deny: (self collection anySatisfy: [ :each | each = Object new ])
  491. !
  492. testAsArray
  493. self
  494. assertSameContents: self collection
  495. as: self collection asArray
  496. !
  497. testAsOrderedCollection
  498. self
  499. assertSameContents: self collection
  500. as: self collection asOrderedCollection
  501. !
  502. testAsSet
  503. | c set |
  504. c := self collectionWithDuplicates.
  505. set := c asSet.
  506. self assert: set size equals: 6.
  507. c do: [ :each |
  508. self assert: (set includes: each) ]
  509. !
  510. testCollect
  511. self assert: (self collection collect: [ :each | each ]) equals: self collection.
  512. self assert: (self collectionWithNewValue collect: [ :each | each ]) equals: self collectionWithNewValue.
  513. self assert: (self collectionClass new collect: [ :each | each printString ]) equals: self collectionClass new.
  514. self assert: ((self collection collect: [ self sampleNewValue ]) detect: [ true ]) equals: self sampleNewValue.
  515. self assert: (self collection collect: [ :each | each printString ]) equals: self collectionOfPrintStrings
  516. !
  517. testComma
  518. self assert: self collection, self collectionClass new equals: self collection.
  519. self assert: self collectionClass new, self collection equals: self collection.
  520. self assert: self collectionClass new, self collectionClass new equals: self collectionClass new.
  521. self assert: self collection, self sampleNewValueAsCollection equals: self collectionWithNewValue.
  522. self assertSameContents: self sampleNewValueAsCollection, self collection as: self collectionWithNewValue
  523. !
  524. testCopy
  525. self assert: self collectionClass new copy equals: self collectionClass new.
  526. self assert: self collection copy equals: self collection.
  527. self assert: self collectionWithNewValue copy equals: self collectionWithNewValue.
  528. self deny: self collectionClass new copy = self collection.
  529. self deny: self collection copy = self collectionClass new.
  530. self deny: self collection copy = self collectionWithNewValue
  531. !
  532. testCopySeparates
  533. | original copy |
  534. original := self collection.
  535. copy := original copy.
  536. copy addAll: self sampleNewValueAsCollection.
  537. self assert: original = self collection
  538. !
  539. testDetect
  540. self
  541. shouldnt: [ self collection detect: [ true ] ]
  542. raise: Error.
  543. self
  544. should: [ self collection detect: [ false ] ]
  545. raise: Error.
  546. self assert: (self sampleNewValueAsCollection detect: [ true ]) equals: self sampleNewValue.
  547. self assert: (self collectionWithNewValue detect: [ :each | each = self sampleNewValue ]) equals: self sampleNewValue.
  548. self
  549. should: [ self collection detect: [ :each | each = self sampleNewValue ] ]
  550. raise: Error
  551. !
  552. testDetectIfNone
  553. | sentinel |
  554. sentinel := Object new.
  555. self assert: (self collection detect: [ true ] ifNone: [ sentinel ]) ~= sentinel.
  556. self assert: (self collection detect: [ false ] ifNone: [ sentinel ]) equals: sentinel.
  557. self assert: (self sampleNewValueAsCollection detect: [ true ] ifNone: [ sentinel ]) equals: self sampleNewValue.
  558. self assert: (self collectionWithNewValue detect: [ :each | each = self sampleNewValue ] ifNone: [ sentinel ]) equals: self sampleNewValue.
  559. self assert: (self collection detect: [ :each | each = self sampleNewValue ] ifNone: [ sentinel ]) equals: sentinel
  560. !
  561. testDo
  562. | newCollection |
  563. newCollection := OrderedCollection new.
  564. self collection do: [ :each |
  565. newCollection add: each ].
  566. self
  567. assertSameContents: self collection
  568. as: newCollection.
  569. newCollection := OrderedCollection new.
  570. self collectionWithDuplicates do: [ :each |
  571. newCollection add: each ].
  572. self
  573. assertSameContents: self collectionWithDuplicates
  574. as: newCollection
  575. !
  576. testEquality
  577. self assert: self collectionClass new equals: self collectionClass new.
  578. self assert: self collection equals: self collection.
  579. self assert: self collectionWithNewValue equals: self collectionWithNewValue.
  580. self deny: self collectionClass new = self collection.
  581. self deny: self collection = self collectionClass new.
  582. self deny: self collection = self collectionWithNewValue
  583. !
  584. testIfEmptyFamily
  585. self assert: (self collectionClass new ifEmpty: [ 42 ]) equals: 42.
  586. self assert: (self collection ifEmpty: [ 42 ]) equals: self collection.
  587. self assert: (self collectionClass new ifNotEmpty: [ 42 ]) equals: self collectionClass new.
  588. self assert: (self collection ifNotEmpty: [ 42 ]) equals: 42.
  589. self assert: (self collection ifNotEmpty: [ :col | col ]) equals: self collection.
  590. self assert: (self collectionClass new ifEmpty: [ 42 ] ifNotEmpty: [ 999 ]) equals: 42.
  591. self assert: (self collection ifEmpty: [ 42 ] ifNotEmpty: [ 999 ]) equals: 999.
  592. self assert: (self collection ifEmpty: [ 42 ] ifNotEmpty: [ :col | col ]) equals: self collection.
  593. self assert: (self collectionClass new ifNotEmpty: [ 42 ] ifEmpty: [ 999 ]) equals: 999.
  594. self assert: (self collection ifNotEmpty: [ 42 ] ifEmpty: [ 999 ]) equals: 42.
  595. self assert: (self collection ifNotEmpty: [ :col | col ] ifEmpty: [ 999 ]) equals: self collection.
  596. !
  597. testIsEmpty
  598. self assert: self collectionClass new isEmpty.
  599. self deny: self collection isEmpty
  600. !
  601. testNoneSatisfy
  602. | anyOne |
  603. anyOne := self collection anyOne.
  604. self deny: (self collection noneSatisfy: [ :each | each = anyOne ]).
  605. self assert: (self collection noneSatisfy: [ :each | each = Object new ])
  606. !
  607. testRemoveAll
  608. self assert: (self collection removeAll; yourself) equals: self collectionClass new
  609. !
  610. testSelect
  611. self assert: (self collection select: [ false ]) equals: self collectionClass new.
  612. self assert: (self collection select: [ true ]) equals: self collection.
  613. self assert: (self collectionWithNewValue select: [ :each | each = self sampleNewValue ]) equals: self sampleNewValueAsCollection.
  614. self assert: (self collectionWithNewValue select: [ :each | each ~= self sampleNewValue ]) equals: self collection.
  615. self assert: (self collection select: [ :each | each = self sampleNewValue ]) equals: self collectionClass new.
  616. self assert: (self collectionWithNewValue select: [ :each | each ~= self sampleNewValue ]) equals: self collection
  617. !
  618. testSelectThenCollect
  619. self assert: (self collection select: [ false ] thenCollect: #isString) equals: self collectionClass new.
  620. self assert: (self collection select: [ true ] thenCollect: [:x|x]) equals: self collection.
  621. self assert: (self collection select: [ :each | each = self sampleNewValue ] thenCollect: [:x|x]) equals: self collectionClass new.
  622. self assert: (self collectionWithNewValue select: [ :each | each ~= self sampleNewValue ] thenCollect: #printString) equals: self collectionOfPrintStrings
  623. !
  624. testSingle
  625. self should: [ self collectionClass new single ] raise: Error.
  626. self should: [ self collection single ] raise: Error.
  627. self assert: self sampleNewValueAsCollection single equals: self sampleNewValue
  628. !
  629. testSize
  630. self assert: self collectionClass new size equals: 0.
  631. self assert: self sampleNewValueAsCollection size equals: 1.
  632. self assert: self collection size equals: self collectionSize
  633. ! !
  634. !CollectionTest class methodsFor: 'fixture'!
  635. collectionClass
  636. "Answers class of collection type tested,
  637. or nil if test is abstract"
  638. ^ nil
  639. ! !
  640. !CollectionTest class methodsFor: 'testing'!
  641. isAbstract
  642. ^ self collectionClass isNil
  643. ! !
  644. CollectionTest subclass: #IndexableCollectionTest
  645. instanceVariableNames: ''
  646. package: 'Kernel-Tests'!
  647. !IndexableCollectionTest methodsFor: 'fixture'!
  648. collectionWithNewValue
  649. "Answers a collection which shows how
  650. self collection would look after adding
  651. self sampleNewValue at self sampleNewIndex"
  652. self subclassResponsibility
  653. !
  654. sampleNewIndex
  655. "Answers a value that can be used as index in at:put: or at:ifAbsentPut:"
  656. self subclassResponsibility
  657. !
  658. sampleNonIndexesDo: aBlock
  659. "Executes block a few times,
  660. each time passing value that is known
  661. not to be an index, as the first parameter"
  662. self subclassResponsibility
  663. !
  664. samplesDo: aBlock
  665. "Executes block a few times,
  666. each time passing known index and value stored
  667. under that index as the parameters"
  668. self subclassResponsibility
  669. ! !
  670. !IndexableCollectionTest methodsFor: 'tests'!
  671. testAt
  672. self nonIndexesDo: [ :each |
  673. self should: [ self collection at: each ] raise: Error ].
  674. self samplesDo: [ :index :value |
  675. self assert: (self collection at: index) equals: value ]
  676. !
  677. testAtIfAbsent
  678. self nonIndexesDo: [ :each |
  679. self assert: (self collection at: each ifAbsent: [ self sampleNewValue ]) equals: self sampleNewValue ].
  680. self samplesDo: [ :index :value |
  681. self assert: (self collection at: index ifAbsent: [ self sampleNewValue ]) equals: value ].
  682. !
  683. testAtIfAbsentPut
  684. | newCollection |
  685. newCollection := self collection.
  686. self samplesDo: [ :index :value |
  687. self assert: (newCollection at: index ifAbsentPut: [ self sampleNewValue ]) equals: value ].
  688. self assert: newCollection equals: self collection.
  689. self assert: (newCollection at: self sampleNewIndex ifAbsentPut: [ self sampleNewValue ]) equals: self sampleNewValue.
  690. self assert: newCollection equals: self collectionWithNewValue
  691. !
  692. testAtIfPresent
  693. | visited sentinel |
  694. sentinel := Object new.
  695. self nonIndexesDo: [ :each |
  696. visited := nil.
  697. self assert: (self collection at: each ifPresent: [ :value1 | visited := value1. sentinel ]) equals: nil.
  698. self assert: visited isNil ].
  699. self samplesDo: [ :index :value |
  700. visited := nil.
  701. self assert: (self collection at: index ifPresent: [ :value2 | visited := value2. sentinel ]) equals: sentinel.
  702. self assert: visited equals: (self collection at: index) ]
  703. !
  704. testAtIfPresentIfAbsent
  705. | visited sentinel |
  706. sentinel := Object new.
  707. self nonIndexesDo: [ :each |
  708. visited := nil.
  709. self assert: (self collection at: each ifPresent: [ :value1 | visited := value1. sentinel ] ifAbsent: [ self sampleNewValue ] ) equals: self sampleNewValue.
  710. self assert: visited isNil ].
  711. self samplesDo: [ :index :value |
  712. visited := nil.
  713. self assert: (self collection at: index ifPresent: [ :value2 | visited := value2. sentinel ] ifAbsent: [ self sampleNewValue ]) equals: sentinel.
  714. self assert: visited equals: (self collection at: index) ]
  715. !
  716. testAtPut
  717. | newCollection |
  718. newCollection := self collection.
  719. self samplesDo: [ :index :value |
  720. newCollection at: index put: value ].
  721. self assert: newCollection equals: self collection.
  722. newCollection at: self sampleNewIndex put: self sampleNewValue.
  723. self assert: newCollection equals: self collectionWithNewValue
  724. !
  725. testIndexOf
  726. self should: [ self collection indexOf: self sampleNewValue ] raise: Error.
  727. self samplesDo: [ :index :value |
  728. self assert: (self collection indexOf: value) equals: index ]
  729. !
  730. testIndexOfWithNull
  731. | jsNull |
  732. jsNull := JSON parse: 'null'.
  733. self samplesDo: [ :index :value |
  734. self assert: (self collection at: index put: jsNull; indexOf: jsNull) equals: index ]
  735. !
  736. testWithIndexDo
  737. | collection |
  738. collection := self collection.
  739. self collection withIndexDo: [ :each :index |
  740. self assert: (collection at: index) equals: each ]
  741. ! !
  742. IndexableCollectionTest subclass: #AssociativeCollectionTest
  743. instanceVariableNames: ''
  744. package: 'Kernel-Tests'!
  745. !AssociativeCollectionTest methodsFor: 'fixture'!
  746. collectionKeys
  747. self subclassResponsibility
  748. !
  749. collectionValues
  750. self subclassResponsibility
  751. !
  752. nonIndexesDo: aBlock
  753. aBlock value: 5.
  754. aBlock value: [].
  755. aBlock value: Object new.
  756. aBlock value: 'z'
  757. !
  758. sampleNewIndex
  759. ^ 'new'
  760. !
  761. samplesDo: aBlock
  762. aBlock value: 'a' value: 2
  763. ! !
  764. !AssociativeCollectionTest methodsFor: 'tests'!
  765. testAddAll
  766. super testAddAll.
  767. self assert: (self collection addAll: self collection; yourself) equals: self collection.
  768. self assert: (self collection addAll: self collectionWithNewValue; yourself) equals: self collectionWithNewValue.
  769. self assert: (self collectionWithNewValue addAll: self collection; yourself) equals: self collectionWithNewValue
  770. !
  771. testAsDictionary
  772. self assert: ( self collectionClass new asDictionary isMemberOf: Dictionary ).
  773. !
  774. testAsHashedCollection
  775. self assert: ( self collectionClass new asHashedCollection isMemberOf: HashedCollection ).
  776. !
  777. testComma
  778. super testComma.
  779. self assert: self collection, self collection equals: self collection.
  780. self assert: self collection, self collectionWithNewValue equals: self collectionWithNewValue.
  781. self assert: self collectionWithNewValue, self collection equals: self collectionWithNewValue
  782. !
  783. testFrom
  784. "Accept a collection of associations."
  785. | associations |
  786. associations := { 'a' -> 1. 'b' -> 2 }.
  787. self assertSameContents: ( self class collectionClass from: associations ) as: #{ 'a' -> 1. 'b' -> 2 }.
  788. !
  789. testKeys
  790. self assert:self collectionClass new keys isEmpty.
  791. self assertSameContents:self collection keys as: self collectionKeys.
  792. self assertSameContents:self collectionWithNewValue keys as: self collectionKeys, { self sampleNewIndex }
  793. !
  794. testNewFromPairs
  795. "Accept an array in which all odd indexes are keys and evens are values."
  796. | flattenedAssociations |
  797. flattenedAssociations := { 'a'. 1. 'b'. 2 }.
  798. self assertSameContents: ( self class collectionClass newFromPairs: flattenedAssociations ) as: #{ 'a' -> 1. 'b' -> 2 }.
  799. !
  800. testPrintString
  801. self
  802. assert: (self collectionClass new
  803. at:'firstname' put: 'James';
  804. at:'lastname' put: 'Bond';
  805. printString)
  806. equals: 'a ', self collectionClass name, ' (''firstname'' -> ''James'' , ''lastname'' -> ''Bond'')'
  807. !
  808. testRemoveKey
  809. self nonIndexesDo: [ :each |
  810. | collection |
  811. collection := self collection.
  812. self should: [ collection removeKey: each ] raise: Error.
  813. self assert: collection equals: self collection ].
  814. self samplesDo: [ :index :value |
  815. | collection |
  816. collection := self collection.
  817. self assert: (collection removeKey: index) equals: value.
  818. self deny: collection = self collection ].
  819. self
  820. assert: (self collectionWithNewValue removeKey: self sampleNewIndex; yourself)
  821. equals: self collection
  822. !
  823. testRemoveKeyIfAbsent
  824. self nonIndexesDo: [ :each |
  825. | collection |
  826. collection := self collection.
  827. self assert: (collection removeKey: each ifAbsent: [ self sampleNewValue ]) equals: self sampleNewValue.
  828. self assert: collection equals: self collection ].
  829. self samplesDo: [ :index :value |
  830. | collection |
  831. collection := self collection.
  832. self assert: (collection removeKey: index ifAbsent: [ self sampleNewValue ]) equals: value.
  833. self deny: collection = self collection ].
  834. self
  835. assert: (self collectionWithNewValue removeKey: self sampleNewIndex ifAbsent: [ self assert: false ]; yourself)
  836. equals: self collection
  837. !
  838. testValues
  839. self assert:self collectionClass new values isEmpty.
  840. self assertSameContents:self collection values as: self collectionValues.
  841. self assertSameContents:self collectionWithNewValue values as: self collectionValues, { self sampleNewValue }
  842. ! !
  843. AssociativeCollectionTest subclass: #DictionaryTest
  844. instanceVariableNames: ''
  845. package: 'Kernel-Tests'!
  846. !DictionaryTest methodsFor: 'fixture'!
  847. collection
  848. ^ Dictionary new
  849. at: 1 put: 1;
  850. at: 'a' put: 2;
  851. at: true put: 3;
  852. at: 1@3 put: -4;
  853. at: sampleBlock put: 9;
  854. yourself
  855. !
  856. collectionKeys
  857. ^ {1. 'a'. true. 1@3. sampleBlock}
  858. !
  859. collectionOfPrintStrings
  860. ^ Dictionary new
  861. at: 1 put: '1';
  862. at: 'a' put: '2';
  863. at: true put: '3';
  864. at: 1@3 put: '-4';
  865. at: sampleBlock put: '9';
  866. yourself
  867. !
  868. collectionSize
  869. ^ 5
  870. !
  871. collectionValues
  872. ^ {1. 2. 3. -4. 9}
  873. !
  874. collectionWithDuplicates
  875. ^ Dictionary new
  876. at: 1 put: 1;
  877. at: 'a' put: 2;
  878. at: true put: 3;
  879. at: 4 put: -4;
  880. at: sampleBlock put: 9;
  881. at: 'b' put: 1;
  882. at: 3 put: 3;
  883. at: false put: 12;
  884. yourself
  885. !
  886. collectionWithNewValue
  887. ^ Dictionary new
  888. at: 1 put: 1;
  889. at: 'a' put: 2;
  890. at: true put: 3;
  891. at: 1@3 put: -4;
  892. at: sampleBlock put: 9;
  893. at: 'new' put: 'N';
  894. yourself
  895. !
  896. sampleNewValueAsCollection
  897. ^ Dictionary new
  898. at: 'new' put: 'N';
  899. yourself
  900. !
  901. samplesDo: aBlock
  902. super samplesDo: aBlock.
  903. aBlock value: true value: 3.
  904. aBlock value: 1@3 value: -4.
  905. aBlock value: sampleBlock value: 9
  906. ! !
  907. !DictionaryTest methodsFor: 'tests'!
  908. testAccessing
  909. | d |
  910. d := Dictionary new.
  911. d at: 'hello' put: 'world'.
  912. self assert: (d at: 'hello') equals: 'world'.
  913. self assert: (d at: 'hello' ifAbsent: [ nil ]) equals: 'world'.
  914. self deny: (d at: 'foo' ifAbsent: [ nil ]) = 'world'.
  915. self assert: (d includesKey: 'hello').
  916. self deny: (d includesKey: 'foo').
  917. d at: 1 put: 2.
  918. self assert: (d at: 1) equals: 2.
  919. d at: 1@3 put: 3.
  920. self assert: (d at: 1@3) equals: 3.
  921. self assert: (d includesKey: 1@3).
  922. self deny: (d includesKey: 3@1)
  923. !
  924. testDynamicDictionaries
  925. self assert: #{'hello' -> 1} asDictionary equals: (Dictionary with: 'hello' -> 1)
  926. ! !
  927. !DictionaryTest class methodsFor: 'fixture'!
  928. collectionClass
  929. ^ Dictionary
  930. ! !
  931. AssociativeCollectionTest subclass: #HashedCollectionTest
  932. instanceVariableNames: ''
  933. package: 'Kernel-Tests'!
  934. !HashedCollectionTest methodsFor: 'fixture'!
  935. collection
  936. ^ #{ 'b' -> 1. 'a' -> 2. 'c' -> 3. 'd' -> -4 }
  937. !
  938. collectionKeys
  939. ^ { 'b'. 'a'. 'c'. 'd' }
  940. !
  941. collectionOfPrintStrings
  942. ^ #{ 'b' -> '1'. 'a' -> '2'. 'c' -> '3'. 'd' -> '-4' }
  943. !
  944. collectionSize
  945. ^ 4
  946. !
  947. collectionValues
  948. ^ { 1. 2. 3. -4 }
  949. !
  950. collectionWithDuplicates
  951. ^ #{ 'b' -> 1. 'a' -> 2. 'c' -> 3. 'd' -> -4. 'e' -> 1. 'f' -> 2. 'g' -> 10. 'h' -> 0 }
  952. !
  953. collectionWithNewValue
  954. ^ #{ 'b' -> 1. 'a' -> 2. 'c' -> 3. 'd' -> -4. 'new' -> 'N' }
  955. !
  956. sampleNewValueAsCollection
  957. ^ #{ 'new' -> 'N' }
  958. ! !
  959. !HashedCollectionTest methodsFor: 'tests'!
  960. testDynamicDictionaries
  961. self assert: #{'hello' -> 1} asHashedCollection equals: (HashedCollection with: 'hello' -> 1)
  962. ! !
  963. !HashedCollectionTest class methodsFor: 'fixture'!
  964. collectionClass
  965. ^ HashedCollection
  966. ! !
  967. IndexableCollectionTest subclass: #SequenceableCollectionTest
  968. instanceVariableNames: ''
  969. package: 'Kernel-Tests'!
  970. !SequenceableCollectionTest methodsFor: 'fixture'!
  971. collectionFirst
  972. self subclassResponsibility
  973. !
  974. collectionFirstTwo
  975. self subclassResponsibility
  976. !
  977. collectionLast
  978. self subclassResponsibility
  979. !
  980. collectionLastTwo
  981. self subclassResponsibility
  982. !
  983. nonIndexesDo: aBlock
  984. aBlock value: 0.
  985. aBlock value: self collectionSize + 1.
  986. aBlock value: 'z'
  987. !
  988. samplesDo: aBlock
  989. aBlock value: 1 value: self collectionFirst.
  990. aBlock value: self collectionSize value: self collectionLast
  991. ! !
  992. !SequenceableCollectionTest methodsFor: 'tests'!
  993. testBeginsWith
  994. self assert: (self collection beginsWith: self collectionClass new).
  995. self assert: (self collection beginsWith: self collection).
  996. self assert: (self collection beginsWith: self collectionFirstTwo).
  997. self deny: (self collection beginsWith: self collectionLastTwo)
  998. !
  999. testEndsWith
  1000. self assert: (self collection endsWith: self collectionClass new).
  1001. self assert: (self collection endsWith: self collection).
  1002. self assert: (self collection endsWith: self collectionLastTwo).
  1003. self deny: (self collection endsWith: self collectionFirstTwo)
  1004. !
  1005. testFirst
  1006. self assert: self collection first equals: self collectionFirst
  1007. !
  1008. testFirstN
  1009. self
  1010. assert: (self collection first: 2)
  1011. equals: self collectionFirstTwo.
  1012. self
  1013. assert: (self collection first: 0)
  1014. equals: self collectionClass new.
  1015. self
  1016. assert: (self collection first: self collectionSize)
  1017. equals: self collection.
  1018. self should: [ self collection first: 33 ] raise: Error
  1019. !
  1020. testFourth
  1021. self assert: (self collection fourth) equals: (self collection at: 4)
  1022. !
  1023. testIndexOfStartingAt
  1024. | jsNull |
  1025. jsNull := JSON parse: 'null'.
  1026. self samplesDo: [ :index :value |
  1027. self assert: (self collection indexOf: value startingAt: 1) equals: index.
  1028. self assert: (self collection indexOf: value startingAt: index) equals: index.
  1029. self assert: (self collection indexOf: value startingAt: index+1) equals: 0 ]
  1030. !
  1031. testIndexOfStartingAtWithNull
  1032. | jsNull |
  1033. jsNull := JSON parse: 'null'.
  1034. self samplesDo: [ :index :value | | collection |
  1035. collection := self collection.
  1036. collection at: index put: jsNull.
  1037. self assert: (collection indexOf: jsNull startingAt: 1) equals: index.
  1038. self assert: (collection indexOf: jsNull startingAt: index) equals: index.
  1039. self assert: (collection indexOf: jsNull startingAt: index+1) equals: 0 ]
  1040. !
  1041. testLast
  1042. self assert: self collection last equals: self collectionLast
  1043. !
  1044. testLastN
  1045. self
  1046. assert: (self collection last: 2)
  1047. equals: self collectionLastTwo.
  1048. self
  1049. assert: (self collection last: 0)
  1050. equals: self collectionClass new.
  1051. self
  1052. assert: (self collection last: self collectionSize)
  1053. equals: self collection.
  1054. self should: [ self collection last: 33 ] raise: Error
  1055. !
  1056. testSecond
  1057. self assert: (self collection second) equals: (self collection at: 2)
  1058. !
  1059. testThird
  1060. self assert: (self collection third) equals: (self collection at: 3)
  1061. ! !
  1062. SequenceableCollectionTest subclass: #ArrayTest
  1063. instanceVariableNames: ''
  1064. package: 'Kernel-Tests'!
  1065. !ArrayTest methodsFor: 'fixture'!
  1066. collection
  1067. ^ #(1 2 3 -4)
  1068. !
  1069. collectionFirst
  1070. ^ 1
  1071. !
  1072. collectionFirstTwo
  1073. ^ #(1 2)
  1074. !
  1075. collectionLast
  1076. ^ -4
  1077. !
  1078. collectionLastTwo
  1079. ^ #(3 -4)
  1080. !
  1081. collectionOfPrintStrings
  1082. ^ #('1' '2' '3' '-4')
  1083. !
  1084. collectionSize
  1085. ^ 4
  1086. !
  1087. collectionWithDuplicates
  1088. ^ #('a' 'b' 'c' 1 2 1 'a' ())
  1089. !
  1090. collectionWithNewValue
  1091. ^ #(1 2 3 -4 'N')
  1092. !
  1093. sampleNewIndex
  1094. ^ 5
  1095. !
  1096. samplesDo: aBlock
  1097. super samplesDo: aBlock.
  1098. aBlock value: 3 value: 3.
  1099. ! !
  1100. !ArrayTest methodsFor: 'tests'!
  1101. testAdd
  1102. | array |
  1103. array := self collection.
  1104. array add: 6.
  1105. self assert: array last equals: 6
  1106. !
  1107. testAddFirst
  1108. self assert: (self collection addFirst: 0; yourself) first equals: 0
  1109. !
  1110. testPrintString
  1111. | array |
  1112. array := Array new.
  1113. self assert: array printString equals: 'an Array ()'.
  1114. array add: 1; add: 3.
  1115. self assert: array printString equals: 'an Array (1 3)'.
  1116. array add: 'foo'.
  1117. self assert: array printString equals: 'an Array (1 3 ''foo'')'.
  1118. array remove: 1; remove: 3.
  1119. self assert: array printString equals: 'an Array (''foo'')'.
  1120. array addLast: 3.
  1121. self assert: array printString equals: 'an Array (''foo'' 3)'.
  1122. array addLast: 3.
  1123. self assert: array printString equals: 'an Array (''foo'' 3 3)'.
  1124. !
  1125. testRemove
  1126. | array |
  1127. array := #(1 2 3 4 5).
  1128. array remove: 3.
  1129. self assert: array equals: #(1 2 4 5).
  1130. self should: [ array remove: 3 ] raise: Error
  1131. !
  1132. testRemoveFromTo
  1133. self assert: (#(1 2 3 4) removeFrom: 1 to: 3) equals: #(4).
  1134. self assert: (#(1 2 3 4) removeFrom: 2 to: 3) equals: #(1 4).
  1135. self assert: (#(1 2 3 4) removeFrom: 2 to: 4) equals: #(1)
  1136. !
  1137. testRemoveIndex
  1138. self assert: (#(1 2 3 4) removeIndex: 2) equals: #(1 3 4).
  1139. self assert: (#(1 2 3 4) removeIndex: 1) equals: #(2 3 4).
  1140. self assert: (#('hello') removeIndex: 1) equals: #()
  1141. !
  1142. testRemoveLast
  1143. | array |
  1144. array := #(1 2).
  1145. array removeLast.
  1146. self assert: array last equals: 1
  1147. !
  1148. testReversed
  1149. |array|
  1150. array := #(5 4 3 2 1).
  1151. self assert: (array reversed) equals: #(1 2 3 4 5)
  1152. !
  1153. testSort
  1154. | array |
  1155. array := #(10 1 5).
  1156. array sort.
  1157. self assert: array equals: #(1 5 10)
  1158. ! !
  1159. !ArrayTest class methodsFor: 'fixture'!
  1160. collectionClass
  1161. ^ Array
  1162. ! !
  1163. SequenceableCollectionTest subclass: #StringTest
  1164. instanceVariableNames: ''
  1165. package: 'Kernel-Tests'!
  1166. !StringTest methodsFor: 'fixture'!
  1167. collection
  1168. ^ 'helLo'
  1169. !
  1170. collectionFirst
  1171. ^ 'h'
  1172. !
  1173. collectionFirstTwo
  1174. ^ 'he'
  1175. !
  1176. collectionLast
  1177. ^ 'o'
  1178. !
  1179. collectionLastTwo
  1180. ^ 'Lo'
  1181. !
  1182. collectionOfPrintStrings
  1183. ^ '''h''''e''''l''''L''''o'''
  1184. !
  1185. collectionSize
  1186. ^ 5
  1187. !
  1188. collectionWithDuplicates
  1189. ^ 'abbaerten'
  1190. !
  1191. collectionWithNewValue
  1192. ^ 'helLoN'
  1193. !
  1194. sampleNewValueAsCollection
  1195. ^ 'N'
  1196. !
  1197. samplesDo: aBlock
  1198. super samplesDo: aBlock.
  1199. aBlock value: 3 value: 'l'
  1200. ! !
  1201. !StringTest methodsFor: 'tests'!
  1202. testAddAll
  1203. "String instances are read-only"
  1204. self should: [ self collection addAll: self collection ] raise: Error
  1205. !
  1206. testAddRemove
  1207. self should: [ 'hello' add: 'a' ] raise: Error.
  1208. self should: [ 'hello' remove: 'h' ] raise: Error
  1209. !
  1210. testAsArray
  1211. self assert: 'hello' asArray equals: #('h' 'e' 'l' 'l' 'o').
  1212. !
  1213. testAsLowerCase
  1214. self assert: 'JACKIE' asLowercase equals: 'jackie'.
  1215. !
  1216. testAsNumber
  1217. self assert: '3' asNumber equals: 3.
  1218. self assert: '-3' asNumber equals: -3.
  1219. self assert: '-1.5' asNumber equals: -1.5.
  1220. !
  1221. testAsUpperCase
  1222. self assert: 'jackie' asUppercase equals: 'JACKIE'.
  1223. !
  1224. testAsciiValue
  1225. | characterA characterU |
  1226. characterA := 'A'.
  1227. characterU := 'U'.
  1228. self assert: (characterA asciiValue) equals:65.
  1229. self assert: (characterU asciiValue) equals:85
  1230. !
  1231. testAtIfAbsentPut
  1232. "String instances are read-only"
  1233. self should: [ 'hello' at: 6 ifAbsentPut: [ 'a' ] ] raise: Error
  1234. !
  1235. testAtPut
  1236. "String instances are read-only"
  1237. self should: [ 'hello' at: 1 put: 'a' ] raise: Error
  1238. !
  1239. testCapitalized
  1240. self assert: 'test' capitalized equals: 'Test'.
  1241. self assert: 'Test' capitalized equals: 'Test'.
  1242. self assert: '' capitalized equals: ''.
  1243. self assert: 'Test' isCapitalized equals: true.
  1244. self assert: 'test' isCapitalized equals: false.
  1245. !
  1246. testCharCodeAt
  1247. self assert: ('jackie' charCodeAt:1) equals: 106.
  1248. self assert: ('jackie' charCodeAt:2) equals: 97.
  1249. self assert: ('jackie' charCodeAt:3) equals: 99.
  1250. self assert: ('jackie' charCodeAt:4) equals: 107.
  1251. self assert: ('jackie' charCodeAt:5) equals: 105.
  1252. self assert: ('jackie' charCodeAt:6) equals: 101
  1253. !
  1254. testCopyFromTo
  1255. self assert: ('jackie' copyFrom: 1 to: 3) equals: 'jac'.
  1256. self assert: ('jackie' copyFrom: 4 to: 6) equals: 'kie'.
  1257. !
  1258. testCopySeparates
  1259. "String instances are immutable"
  1260. self assert: self collection copy == self collection
  1261. !
  1262. testCopyWithoutAll
  1263. self
  1264. assert: ('*hello* *world*' copyWithoutAll: '*')
  1265. equals: 'hello world'
  1266. !
  1267. testEquality
  1268. self assert: 'hello' equals: 'hello'.
  1269. self deny: 'hello' = 'world'.
  1270. "Test for issue 459"
  1271. self deny: 'hello' = (#() at: 1 ifAbsent: [ ]).
  1272. self assert: 'hello' equals: 'hello' yourself.
  1273. self assert: 'hello' yourself equals: 'hello'.
  1274. "test JS falsy value"
  1275. self deny: '' = 0
  1276. !
  1277. testIdentity
  1278. self assert: 'hello' == 'hello'.
  1279. self deny: 'hello' == 'world'.
  1280. self assert: 'hello' == 'hello' yourself.
  1281. self assert: 'hello' yourself == 'hello'.
  1282. "test JS falsy value"
  1283. self deny: '' == 0
  1284. !
  1285. testIncludesSubString
  1286. self assert: ('amber' includesSubString: 'ber').
  1287. self deny: ('amber' includesSubString: 'zork').
  1288. !
  1289. testIndexOfStartingAtWithNull
  1290. "String cannot hold JS null"
  1291. !
  1292. testIndexOfWithNull
  1293. "String cannot hold JS null"
  1294. !
  1295. testIsVowel
  1296. |vowel consonant|
  1297. vowel := 'u'.
  1298. consonant := 'z'.
  1299. self assert: vowel isVowel equals: true.
  1300. self assert: consonant isVowel equals: false
  1301. !
  1302. testJoin
  1303. self assert: (',' join: #('hello' 'world')) equals: 'hello,world'
  1304. !
  1305. testRemoveAll
  1306. self should: [ self collection removeAll ] raise: Error
  1307. !
  1308. testReversed
  1309. self assert: 'jackiechan' reversed equals: 'nahceikcaj'.
  1310. !
  1311. testStreamContents
  1312. self
  1313. assert: (String streamContents: [ :aStream |
  1314. aStream
  1315. nextPutAll: 'hello'; space;
  1316. nextPutAll: 'world' ])
  1317. equals: 'hello world'
  1318. !
  1319. testSubStrings
  1320. self assert: ('jackiechan' subStrings: 'ie') equals: #( 'jack' 'chan' ).
  1321. !
  1322. testTrim
  1323. self assert: ' jackie' trimLeft equals: 'jackie'.
  1324. self assert: 'jackie ' trimRight equals: 'jackie'.
  1325. !
  1326. testValue
  1327. self assert: (#asString value: 1) equals: '1'.
  1328. "Which (since String and BlockClosure are now polymorphic) enables the nice idiom..."
  1329. self assert: (#(1 2 3) collect: #asString) equals: #('1' '2' '3')
  1330. ! !
  1331. !StringTest class methodsFor: 'fixture'!
  1332. collectionClass
  1333. ^ String
  1334. ! !
  1335. CollectionTest subclass: #SetTest
  1336. instanceVariableNames: ''
  1337. package: 'Kernel-Tests'!
  1338. !SetTest methodsFor: 'fixture'!
  1339. collection
  1340. ^ Set new
  1341. add: Smalltalk;
  1342. add: nil;
  1343. add: 3@3;
  1344. add: false;
  1345. add: sampleBlock;
  1346. yourself
  1347. !
  1348. collectionOfPrintStrings
  1349. ^ Set new
  1350. add: 'a SmalltalkImage';
  1351. add: 'nil';
  1352. add: '3@3';
  1353. add: 'false';
  1354. add: 'a BlockClosure';
  1355. yourself
  1356. !
  1357. collectionSize
  1358. ^ 5
  1359. !
  1360. collectionWithDuplicates
  1361. "Set has no duplicates"
  1362. ^ self collection add: 0; yourself
  1363. !
  1364. collectionWithNewValue
  1365. ^ Set new
  1366. add: Smalltalk;
  1367. add: nil;
  1368. add: 3@3;
  1369. add: 'N';
  1370. add: false;
  1371. add: sampleBlock;
  1372. yourself
  1373. ! !
  1374. !SetTest methodsFor: 'tests'!
  1375. testAddAll
  1376. super testAddAll.
  1377. self assert: (self collection addAll: self collection; yourself) equals: self collection.
  1378. self assert: (self collection addAll: self collectionWithNewValue; yourself) equals: self collectionWithNewValue.
  1379. self assert: (self collectionWithNewValue addAll: self collection; yourself) equals: self collectionWithNewValue
  1380. !
  1381. testAddRemove
  1382. | set |
  1383. set := Set new.
  1384. self assert: set isEmpty.
  1385. set add: 3.
  1386. self assert: (set includes: 3).
  1387. set add: 5.
  1388. self assert: (set includes: 5).
  1389. set remove: 3.
  1390. self deny: (set includes: 3)
  1391. !
  1392. testAt
  1393. self should: [ Set new at: 1 put: 2 ] raise: Error
  1394. !
  1395. testCollect
  1396. super testCollect.
  1397. self assert: (#(5 6 8) asSet collect: [ :x | x \\ 3 ]) equals: #(0 2) asSet
  1398. !
  1399. testComma
  1400. super testComma.
  1401. self assert: self collection, self collection equals: self collection.
  1402. self assert: self collection, self collectionWithNewValue equals: self collectionWithNewValue.
  1403. self assert: self collectionWithNewValue, self collection equals: self collectionWithNewValue
  1404. !
  1405. testComparing
  1406. self assert: #(0 2) asSet equals: #(0 2) asSet.
  1407. self assert: #(2 0) asSet equals: #(0 2) asSet.
  1408. self deny: #(0 2 3) asSet = #(0 2) asSet.
  1409. self deny: #(1 2) asSet = #(0 2) asSet
  1410. !
  1411. testPrintString
  1412. | set |
  1413. set := Set new.
  1414. self assert: set printString equals: 'a Set ()'.
  1415. set add: 1; add: 3.
  1416. self assert: set printString equals: 'a Set (1 3)'.
  1417. set add: 'foo'.
  1418. self assert: set printString equals: 'a Set (1 3 ''foo'')'.
  1419. set remove: 1; remove: 3.
  1420. self assert: set printString equals: 'a Set (''foo'')'.
  1421. set add: 3.
  1422. self assert: set printString equals: 'a Set (3 ''foo'')'.
  1423. set add: 3.
  1424. self assert: set printString equals: 'a Set (3 ''foo'')'
  1425. !
  1426. testUnboxedObjects
  1427. self assert: {'foo' yourself. 'foo' yourself} asSet asArray equals: #('foo')
  1428. !
  1429. testUnicity
  1430. | set |
  1431. set := Set new.
  1432. set add: 21.
  1433. set add: 'hello'.
  1434. set add: 21.
  1435. self assert: set size equals: 2.
  1436. set add: 'hello'.
  1437. self assert: set size equals: 2.
  1438. self assert: set asArray equals: #(21 'hello')
  1439. ! !
  1440. !SetTest class methodsFor: 'fixture'!
  1441. collectionClass
  1442. ^ Set
  1443. ! !
  1444. TestCase subclass: #ConsoleTranscriptTest
  1445. instanceVariableNames: ''
  1446. package: 'Kernel-Tests'!
  1447. !ConsoleTranscriptTest methodsFor: 'tests'!
  1448. testShow
  1449. | originalTranscript |
  1450. originalTranscript := Transcript current.
  1451. Transcript register: ConsoleTranscript new.
  1452. self shouldnt: [ Transcript show: 'Hello console!!' ] raise: Error.
  1453. self shouldnt: [ Transcript show: console ] raise: Error.
  1454. Transcript register: originalTranscript.
  1455. ! !
  1456. TestCase subclass: #DateTest
  1457. instanceVariableNames: ''
  1458. package: 'Kernel-Tests'!
  1459. !DateTest methodsFor: 'tests'!
  1460. testEquality
  1461. | now |
  1462. now := Date new.
  1463. self assert: now = now.
  1464. self deny: now = (Date fromMilliseconds: 0).
  1465. self assert: (Date fromMilliseconds: 12345678) = (Date fromMilliseconds: 12345678).
  1466. self assert: now = (Date fromMilliseconds: now asMilliseconds).
  1467. self assert: (Date fromMilliseconds: now asMilliseconds) = now
  1468. !
  1469. testIdentity
  1470. | now |
  1471. now := Date new.
  1472. self assert: now == now.
  1473. self deny: now == (Date fromMilliseconds: 0).
  1474. self deny: (Date fromMilliseconds: 12345678) == (Date fromMilliseconds: 12345678).
  1475. self deny: now == (Date fromMilliseconds: now asMilliseconds).
  1476. self deny: (Date fromMilliseconds: now asMilliseconds) == now
  1477. ! !
  1478. TestCase subclass: #JSObjectProxyTest
  1479. instanceVariableNames: ''
  1480. package: 'Kernel-Tests'!
  1481. !JSObjectProxyTest methodsFor: 'accessing'!
  1482. jsNull
  1483. <inlineJS: 'return null'>
  1484. !
  1485. jsObject
  1486. <inlineJS:
  1487. 'return {a: 1, b: function() {return 2;}, c: function(object) {return object;}, d: "", "e": null, "f": void 0}'>
  1488. !
  1489. jsUndefined
  1490. <inlineJS: 'return'>
  1491. ! !
  1492. !JSObjectProxyTest methodsFor: 'tests'!
  1493. testAtIfAbsent
  1494. | testObject |
  1495. testObject := self jsObject.
  1496. self assert: (testObject at: 'abc' ifAbsent: [ 'Property does not exist' ]) equals: 'Property does not exist'.
  1497. self assert: (testObject at: 'e' ifAbsent: [ 'Property does not exist' ]) equals: nil.
  1498. self assert: (testObject at: 'a' ifAbsent: [ 'Property does not exist' ]) equals: 1.
  1499. self assert: (testObject at: 'f' ifAbsent: [ 'Property does not exist' ]) equals: nil.
  1500. !
  1501. testAtIfPresent
  1502. | testObject |
  1503. testObject := self jsObject.
  1504. self assert: (testObject at: 'abc' ifPresent: [ :x | 'hello ',x asString ]) equals: nil.
  1505. self assert: (testObject at: 'e' ifPresent: [ :x | 'hello ',x asString ]) equals: 'hello nil'.
  1506. self assert: (testObject at: 'a' ifPresent: [ :x | 'hello ',x asString ]) equals: 'hello 1'.
  1507. self assert: (testObject at: 'f' ifPresent: [ :x | 'hello ',x asString ]) equals: 'hello nil'.
  1508. !
  1509. testAtIfPresentIfAbsent
  1510. | testObject |
  1511. testObject := self jsObject.
  1512. self assert: (testObject at: 'abc' ifPresent: [ :x|'hello ',x asString ] ifAbsent: [ 'not present' ]) equals: 'not present'.
  1513. self assert: (testObject at: 'e' ifPresent: [ :x|'hello ',x asString ] ifAbsent: [ 'not present' ]) equals: 'hello nil'.
  1514. self assert: (testObject at: 'a' ifPresent: [ :x|'hello ',x asString ] ifAbsent: [ 'not present' ]) equals: 'hello 1'.
  1515. self assert: (testObject at: 'f' ifPresent: [ :x|'hello ',x asString ] ifAbsent: [ 'not present' ]) equals: 'hello nil'.
  1516. !
  1517. testAtPut
  1518. | testObject |
  1519. testObject := self jsObject.
  1520. self assert: (testObject at: 'abc') ~= 'xyz'.
  1521. self assert: (testObject at: 'abc' put: 'xyz') equals: 'xyz'.
  1522. self assert: (testObject at: 'abc') equals: 'xyz'
  1523. !
  1524. testComparison
  1525. self assert: ({ console. 2 } indexOf: console) equals: 1.
  1526. self assert: console = console.
  1527. self deny: console = Object new.
  1528. self deny: console = self jsObject
  1529. !
  1530. testDNU
  1531. self should: [ self jsObject foo ] raise: MessageNotUnderstood
  1532. !
  1533. testDNURegression1057
  1534. | jsObject |
  1535. jsObject := #().
  1536. jsObject basicAt: 'allowJavaScriptCalls' put: true.
  1537. jsObject basicAt: 'foo' put: 3.
  1538. self shouldnt: [ jsObject foo ] raise: Error.
  1539. self assert: jsObject foo equals: 3.
  1540. self shouldnt: [ jsObject foo: 4 ] raise: Error.
  1541. self assert: jsObject foo equals: 4
  1542. !
  1543. testDNURegression1059
  1544. | jsObject |
  1545. jsObject := #().
  1546. jsObject basicAt: 'allowJavaScriptCalls' put: true.
  1547. jsObject basicAt: 'x' put: 3.
  1548. jsObject basicAt: 'x:' put: [ self error ].
  1549. self shouldnt: [ jsObject x: 4 ] raise: Error.
  1550. self assert: jsObject x equals: 4
  1551. !
  1552. testDNURegression1062
  1553. | jsObject stored |
  1554. jsObject := #().
  1555. jsObject basicAt: 'allowJavaScriptCalls' put: true.
  1556. jsObject basicAt: 'x' put: [ :v | stored := v ].
  1557. self shouldnt: [ jsObject x: 4 ] raise: Error.
  1558. self assert: stored equals: 4
  1559. !
  1560. testDNUWithAllowJavaScriptCalls
  1561. | jsObject |
  1562. jsObject := #().
  1563. jsObject basicAt: 'allowJavaScriptCalls' put: true.
  1564. self should: [ jsObject foo ] raise: MessageNotUnderstood
  1565. !
  1566. testMessageSend
  1567. self assert: self jsObject a equals: 1.
  1568. self assert: self jsObject b equals: 2.
  1569. self assert: (self jsObject c: 3) equals: 3
  1570. !
  1571. testMethodWithArguments
  1572. self assert: (self jsObject c: 1) equals: 1
  1573. !
  1574. testPrinting
  1575. self assert: self jsObject printString equals: '[object Object]'
  1576. !
  1577. testPropertyThatReturnsEmptyString
  1578. | object |
  1579. object := self jsObject.
  1580. self assert: object d equals: ''.
  1581. object d: 'hello'.
  1582. self assert: object d equals: 'hello'
  1583. !
  1584. testPropertyThatReturnsUndefined
  1585. | object |
  1586. object := self jsObject.
  1587. self shouldnt: [ object e ] raise: MessageNotUnderstood.
  1588. self assert: object e isNil
  1589. !
  1590. testSetPropertyWithFalsyValue
  1591. | jsObject |
  1592. jsObject := self jsObject.
  1593. self assert: (jsObject a) equals: 1.
  1594. jsObject a: self jsNull.
  1595. self assert: (jsObject a) equals: nil.
  1596. jsObject a: 0.
  1597. self assert: (jsObject a) equals: 0.
  1598. jsObject a: self jsUndefined.
  1599. self assert: (jsObject a) equals: nil.
  1600. jsObject a: ''.
  1601. self assert: (jsObject a) equals: ''.
  1602. jsObject a: false.
  1603. self assert: (jsObject a) equals: false
  1604. !
  1605. testValue
  1606. | testObject |
  1607. testObject := self jsObject.
  1608. testObject at: 'value' put: 'aValue'.
  1609. self assert: testObject value equals: 'aValue'
  1610. !
  1611. testYourself
  1612. | object |
  1613. object := self jsObject
  1614. d: 'test';
  1615. yourself.
  1616. self assert: object d equals: 'test'
  1617. ! !
  1618. TestCase subclass: #JavaScriptExceptionTest
  1619. instanceVariableNames: ''
  1620. package: 'Kernel-Tests'!
  1621. !JavaScriptExceptionTest methodsFor: 'helpers'!
  1622. throwException
  1623. <inlineJS: 'throw "test"'>
  1624. ! !
  1625. !JavaScriptExceptionTest methodsFor: 'tests'!
  1626. testCatchingException
  1627. [ self throwException ]
  1628. on: Error
  1629. do: [ :error |
  1630. self assert: error exception = 'test' ]
  1631. !
  1632. testRaisingException
  1633. self should: [ self throwException ] raise: JavaScriptException
  1634. ! !
  1635. TestCase subclass: #MessageSendTest
  1636. instanceVariableNames: ''
  1637. package: 'Kernel-Tests'!
  1638. !MessageSendTest methodsFor: 'tests'!
  1639. testValue
  1640. | messageSend |
  1641. messageSend := MessageSend new
  1642. receiver: Object new;
  1643. selector: #asString;
  1644. yourself.
  1645. self assert: messageSend value equals: 'an Object'
  1646. !
  1647. testValueWithArguments
  1648. | messageSend |
  1649. messageSend := MessageSend new
  1650. receiver: 2;
  1651. selector: '+';
  1652. yourself.
  1653. self assert: (messageSend value: 3) equals: 5.
  1654. self assert: (messageSend valueWithPossibleArguments: #(4)) equals: 6
  1655. ! !
  1656. TestCase subclass: #MethodInheritanceTest
  1657. instanceVariableNames: 'receiverTop receiverMiddle receiverBottom method performBlock'
  1658. package: 'Kernel-Tests'!
  1659. !MethodInheritanceTest methodsFor: 'accessing'!
  1660. codeGeneratorClass
  1661. ^ CodeGenerator
  1662. !
  1663. targetClassBottom
  1664. ^ JavaScriptException
  1665. !
  1666. targetClassMiddle
  1667. ^ Error
  1668. !
  1669. targetClassTop
  1670. ^ Object
  1671. ! !
  1672. !MethodInheritanceTest methodsFor: 'factory'!
  1673. compiler
  1674. ^ Compiler new
  1675. codeGeneratorClass: self codeGeneratorClass;
  1676. yourself
  1677. ! !
  1678. !MethodInheritanceTest methodsFor: 'initialization'!
  1679. setUp
  1680. receiverTop := self targetClassTop new.
  1681. receiverMiddle := self targetClassMiddle new.
  1682. receiverBottom := self targetClassBottom new.
  1683. method := nil.
  1684. performBlock := [ self error: 'performBlock not initialized' ]
  1685. !
  1686. tearDown
  1687. [ self deinstallTop ] on: Error do: [ ].
  1688. [ self deinstallMiddle ] on: Error do: [ ].
  1689. [ self deinstallBottom ] on: Error do: [ ]
  1690. ! !
  1691. !MethodInheritanceTest methodsFor: 'testing'!
  1692. deinstallBottom
  1693. self targetClassBottom removeCompiledMethod: method
  1694. !
  1695. deinstallMiddle
  1696. self targetClassMiddle removeCompiledMethod: method
  1697. !
  1698. deinstallTop
  1699. self targetClassTop removeCompiledMethod: method
  1700. !
  1701. installBottom: aString
  1702. method := self compiler install: aString forClass: self targetClassBottom protocol: 'tests'
  1703. !
  1704. installMiddle: aString
  1705. method := self compiler install: aString forClass: self targetClassMiddle protocol: 'tests'
  1706. !
  1707. installTop: aString
  1708. method := self compiler install: aString forClass: self targetClassTop protocol: 'tests'
  1709. !
  1710. shouldMNU
  1711. self shouldMNUTop.
  1712. self shouldMNUMiddle.
  1713. self shouldMNUBottom
  1714. !
  1715. shouldMNUBottom
  1716. self should: [ performBlock value: receiverBottom ] raise: MessageNotUnderstood
  1717. !
  1718. shouldMNUMiddle
  1719. self should: [ performBlock value: receiverMiddle ] raise: MessageNotUnderstood
  1720. !
  1721. shouldMNUTop
  1722. self should: [ performBlock value: receiverTop ] raise: MessageNotUnderstood
  1723. !
  1724. shouldReturn: anObject
  1725. | result |
  1726. result := performBlock value: receiverTop.
  1727. self assert: { 'top'. anObject } equals: { 'top'. result }.
  1728. result := performBlock value: receiverMiddle.
  1729. self assert: { 'middle'. anObject } equals: { 'middle'. result }.
  1730. result := performBlock value: receiverBottom.
  1731. self assert: { 'bottom'. anObject } equals: { 'bottom'. result }
  1732. !
  1733. shouldReturn: anObject and: anObject2 and: anObject3
  1734. | result |
  1735. result := performBlock value: receiverTop.
  1736. self assert: { 'top'. anObject } equals: { 'top'. result }.
  1737. result := performBlock value: receiverMiddle.
  1738. self assert: { 'middle'. anObject2 } equals: { 'middle'. result }.
  1739. result := performBlock value: receiverBottom.
  1740. self assert: { 'bottom'. anObject3 } equals: { 'bottom'. result }
  1741. ! !
  1742. !MethodInheritanceTest methodsFor: 'tests'!
  1743. testMNU11
  1744. performBlock := [ :x | x foo ].
  1745. self shouldMNU.
  1746. self installTop: 'foo ^ false'.
  1747. self installTop: 'foo ^ true'.
  1748. self deinstallTop.
  1749. self shouldMNU
  1750. !
  1751. testMNU22
  1752. performBlock := [ :x | x foo ].
  1753. self shouldMNU.
  1754. self installMiddle: 'foo ^ false'.
  1755. self installMiddle: 'foo ^ true'.
  1756. self deinstallMiddle.
  1757. self shouldMNU
  1758. !
  1759. testReturns1
  1760. performBlock := [ :x | x foo ].
  1761. self installTop: 'foo ^ false'.
  1762. self shouldReturn: false.
  1763. self installTop: 'foo ^ true'.
  1764. self shouldReturn: true
  1765. ! !
  1766. TestCase subclass: #NumberTest
  1767. instanceVariableNames: ''
  1768. package: 'Kernel-Tests'!
  1769. !NumberTest methodsFor: 'tests'!
  1770. testAbs
  1771. self assert: 4 abs equals: 4.
  1772. self assert: -4 abs equals: 4
  1773. !
  1774. testArithmetic
  1775. "We rely on JS here, so we won't test complex behavior, just check if
  1776. message sends are corrects"
  1777. self assert: 1.5 + 1 equals: 2.5.
  1778. self assert: 2 - 1 equals: 1.
  1779. self assert: -2 - 1 equals: -3.
  1780. self assert: 12 / 2 equals: 6.
  1781. self assert: 3 * 4 equals: 12.
  1782. self assert: 7 // 2 equals: 3.
  1783. self assert: 7 \\ 2 equals: 1.
  1784. "Simple parenthesis and execution order"
  1785. self assert: 1 + 2 * 3 equals: 9.
  1786. self assert: 1 + (2 * 3) equals: 7
  1787. !
  1788. testAsNumber
  1789. self assert: 3 asNumber equals: 3.
  1790. !
  1791. testCeiling
  1792. self assert: 1.2 ceiling equals: 2.
  1793. self assert: -1.2 ceiling equals: -1.
  1794. self assert: 1.0 ceiling equals: 1.
  1795. !
  1796. testComparison
  1797. self assert: 3 > 2.
  1798. self assert: 2 < 3.
  1799. self deny: 3 < 2.
  1800. self deny: 2 > 3.
  1801. self assert: 3 >= 3.
  1802. self assert: 3.1 >= 3.
  1803. self assert: 3 <= 3.
  1804. self assert: 3 <= 3.1
  1805. !
  1806. testCopying
  1807. self assert: 1 copy == 1.
  1808. self assert: 1 deepCopy == 1
  1809. !
  1810. testEquality
  1811. self assert: (1 = 1).
  1812. self assert: (0 = 0).
  1813. self deny: (1 = 0).
  1814. self assert: (1 yourself = 1).
  1815. self assert: (1 = 1 yourself).
  1816. self assert: (1 yourself = 1 yourself).
  1817. self deny: 0 = false.
  1818. self deny: false = 0.
  1819. self deny: '' = 0.
  1820. self deny: 0 = ''
  1821. !
  1822. testFloor
  1823. self assert: 1.2 floor equals: 1.
  1824. self assert: -1.2 floor equals: -2.
  1825. self assert: 1.0 floor equals: 1.
  1826. !
  1827. testHexNumbers
  1828. self assert: 16r9 equals: 9.
  1829. self assert: 16rA truncated equals: 10.
  1830. self assert: 16rB truncated equals: 11.
  1831. self assert: 16rC truncated equals: 12.
  1832. self assert: 16rD truncated equals: 13.
  1833. self assert: 16rE truncated equals: 14.
  1834. self assert: 16rF truncated equals: 15
  1835. !
  1836. testIdentity
  1837. self assert: 1 == 1.
  1838. self assert: 0 == 0.
  1839. self deny: 1 == 0.
  1840. self assert: 1 yourself == 1.
  1841. self assert: 1 == 1 yourself.
  1842. self assert: 1 yourself == 1 yourself.
  1843. self deny: 1 == 2
  1844. !
  1845. testInvalidHexNumbers
  1846. self should: [ 16rG ] raise: MessageNotUnderstood.
  1847. self should: [ 16rg ] raise: MessageNotUnderstood.
  1848. self should: [ 16rH ] raise: MessageNotUnderstood.
  1849. self should: [ 16rh ] raise: MessageNotUnderstood.
  1850. self should: [ 16rI ] raise: MessageNotUnderstood.
  1851. self should: [ 16ri ] raise: MessageNotUnderstood.
  1852. self should: [ 16rJ ] raise: MessageNotUnderstood.
  1853. self should: [ 16rj ] raise: MessageNotUnderstood.
  1854. self should: [ 16rK ] raise: MessageNotUnderstood.
  1855. self should: [ 16rk ] raise: MessageNotUnderstood.
  1856. self should: [ 16rL ] raise: MessageNotUnderstood.
  1857. self should: [ 16rl ] raise: MessageNotUnderstood.
  1858. self should: [ 16rM ] raise: MessageNotUnderstood.
  1859. self should: [ 16rm ] raise: MessageNotUnderstood.
  1860. self should: [ 16rN ] raise: MessageNotUnderstood.
  1861. self should: [ 16rn ] raise: MessageNotUnderstood.
  1862. self should: [ 16rO ] raise: MessageNotUnderstood.
  1863. self should: [ 16ro ] raise: MessageNotUnderstood.
  1864. self should: [ 16rP ] raise: MessageNotUnderstood.
  1865. self should: [ 16rp ] raise: MessageNotUnderstood.
  1866. self should: [ 16rQ ] raise: MessageNotUnderstood.
  1867. self should: [ 16rq ] raise: MessageNotUnderstood.
  1868. self should: [ 16rR ] raise: MessageNotUnderstood.
  1869. self should: [ 16rr ] raise: MessageNotUnderstood.
  1870. self should: [ 16rS ] raise: MessageNotUnderstood.
  1871. self should: [ 16rs ] raise: MessageNotUnderstood.
  1872. self should: [ 16rT ] raise: MessageNotUnderstood.
  1873. self should: [ 16rt ] raise: MessageNotUnderstood.
  1874. self should: [ 16rU ] raise: MessageNotUnderstood.
  1875. self should: [ 16ru ] raise: MessageNotUnderstood.
  1876. self should: [ 16rV ] raise: MessageNotUnderstood.
  1877. self should: [ 16rv ] raise: MessageNotUnderstood.
  1878. self should: [ 16rW ] raise: MessageNotUnderstood.
  1879. self should: [ 16rw ] raise: MessageNotUnderstood.
  1880. self should: [ 16rX ] raise: MessageNotUnderstood.
  1881. self should: [ 16rx ] raise: MessageNotUnderstood.
  1882. self should: [ 16rY ] raise: MessageNotUnderstood.
  1883. self should: [ 16ry ] raise: MessageNotUnderstood.
  1884. self should: [ 16rZ ] raise: MessageNotUnderstood.
  1885. self should: [ 16rz ] raise: MessageNotUnderstood.
  1886. self should: [ 16rABcdEfZ ] raise: MessageNotUnderstood.
  1887. !
  1888. testLog
  1889. self assert: 10000 log equals: 4.
  1890. self assert: (512 log: 2) equals: 9.
  1891. self assert: Number e ln equals: 1.
  1892. !
  1893. testMinMax
  1894. self assert: (2 max: 5) equals: 5.
  1895. self assert: (2 min: 5) equals: 2
  1896. !
  1897. testNegated
  1898. self assert: 3 negated equals: -3.
  1899. self assert: -3 negated equals: 3
  1900. !
  1901. testPrintShowingDecimalPlaces
  1902. self assert: (23 printShowingDecimalPlaces: 2) equals: '23.00'.
  1903. self assert: (23.5698 printShowingDecimalPlaces: 2) equals: '23.57'.
  1904. self assert: (234.567 negated printShowingDecimalPlaces: 5) equals: '-234.56700'.
  1905. self assert: (23.4567 printShowingDecimalPlaces: 0) equals: '23'.
  1906. self assert: (23.5567 printShowingDecimalPlaces: 0) equals: '24'.
  1907. self assert: (23.4567 negated printShowingDecimalPlaces: 0) equals: '-23'.
  1908. self assert: (23.5567 negated printShowingDecimalPlaces: 0) equals: '-24'.
  1909. self assert: (100000000 printShowingDecimalPlaces: 1) equals: '100000000.0'.
  1910. self assert: (0.98 printShowingDecimalPlaces: 5) equals: '0.98000'.
  1911. self assert: (0.98 negated printShowingDecimalPlaces: 2) equals: '-0.98'.
  1912. self assert: (2.567 printShowingDecimalPlaces: 2) equals: '2.57'.
  1913. self assert: (-2.567 printShowingDecimalPlaces: 2) equals: '-2.57'.
  1914. self assert: (0 printShowingDecimalPlaces: 2) equals: '0.00'.
  1915. !
  1916. testRaisedTo
  1917. self assert: (2 raisedTo: 4) equals: 16.
  1918. self assert: (2 raisedTo: 0) equals: 1.
  1919. self assert: (2 raisedTo: -3) equals: 0.125.
  1920. self assert: (4 raisedTo: 0.5) equals: 2.
  1921. self assert: 2 ** 4 equals: 16.
  1922. !
  1923. testRounded
  1924. self assert: 3 rounded equals: 3.
  1925. self assert: 3.212 rounded equals: 3.
  1926. self assert: 3.51 rounded equals: 4
  1927. !
  1928. testSign
  1929. self assert: 5 sign equals: 1.
  1930. self assert: 0 sign equals: 0.
  1931. self assert: -1.4 sign equals: -1.
  1932. !
  1933. testSqrt
  1934. self assert: 4 sqrt equals: 2.
  1935. self assert: 16 sqrt equals: 4
  1936. !
  1937. testSquared
  1938. self assert: 4 squared equals: 16
  1939. !
  1940. testTimesRepeat
  1941. | i |
  1942. i := 0.
  1943. 0 timesRepeat: [ i := i + 1 ].
  1944. self assert: i equals: 0.
  1945. 5 timesRepeat: [ i := i + 1 ].
  1946. self assert: i equals: 5
  1947. !
  1948. testTo
  1949. self assert: (1 to: 5) equals: #(1 2 3 4 5)
  1950. !
  1951. testToBy
  1952. self assert: (0 to: 6 by: 2) equals: #(0 2 4 6).
  1953. self should: [ 1 to: 4 by: 0 ] raise: Error
  1954. !
  1955. testTrigonometry
  1956. self assert: 0 cos equals: 1.
  1957. self assert: 0 sin equals: 0.
  1958. self assert: 0 tan equals: 0.
  1959. self assert: 1 arcCos equals: 0.
  1960. self assert: 0 arcSin equals: 0.
  1961. self assert: 0 arcTan equals: 0.
  1962. !
  1963. testTruncated
  1964. self assert: 3 truncated equals: 3.
  1965. self assert: 3.212 truncated equals: 3.
  1966. self assert: 3.51 truncated equals: 3
  1967. ! !
  1968. Object subclass: #ObjectMock
  1969. instanceVariableNames: 'foo bar'
  1970. package: 'Kernel-Tests'!
  1971. !ObjectMock commentStamp!
  1972. ObjectMock is there only to perform tests on classes.!
  1973. !ObjectMock methodsFor: 'not yet classified'!
  1974. foo
  1975. ^ foo
  1976. !
  1977. foo: anObject
  1978. foo := anObject
  1979. ! !
  1980. TestCase subclass: #ObjectTest
  1981. instanceVariableNames: ''
  1982. package: 'Kernel-Tests'!
  1983. !ObjectTest methodsFor: 'tests'!
  1984. notDefined
  1985. <inlineJS: 'return void 0;'>
  1986. !
  1987. testBasicAccess
  1988. | o |
  1989. o := Object new.
  1990. o basicAt: 'a' put: 1.
  1991. self assert: (o basicAt: 'a') equals: 1.
  1992. self assert: (o basicAt: 'b') equals: nil
  1993. !
  1994. testBasicPerform
  1995. | o |
  1996. o := Object new.
  1997. o basicAt: 'func' put: [ 'hello' ].
  1998. o basicAt: 'func2' put: [ :a | a + 1 ].
  1999. self assert: (o basicPerform: 'func') equals: 'hello'.
  2000. self assert: (o basicPerform: 'func2' withArguments: #(3)) equals: 4
  2001. !
  2002. testDNU
  2003. self should: [ Object new foo ] raise: MessageNotUnderstood
  2004. !
  2005. testEquality
  2006. | o |
  2007. o := Object new.
  2008. self deny: o = Object new.
  2009. self assert: (o = o).
  2010. self assert: (o yourself = o).
  2011. self assert: (o = o yourself)
  2012. !
  2013. testHalt
  2014. self should: [ Object new halt ] raise: Error
  2015. !
  2016. testIdentity
  2017. | o |
  2018. o := Object new.
  2019. self deny: o == Object new.
  2020. self assert: o == o.
  2021. self assert: o yourself == o.
  2022. self assert: o == o yourself
  2023. !
  2024. testIfNil
  2025. self deny: Object new isNil.
  2026. self deny: (Object new ifNil: [ true ]) = true.
  2027. self assert: (Object new ifNotNil: [ true ]) equals: true.
  2028. self assert: (Object new ifNil: [ false ] ifNotNil: [ true ]) equals: true.
  2029. self assert: (Object new ifNotNil: [ true ] ifNil: [ false ]) equals: true
  2030. !
  2031. testInstVars
  2032. | o |
  2033. o := ObjectMock new.
  2034. self assert: (o instVarAt: #foo) equals: nil.
  2035. o instVarAt: #foo put: 1.
  2036. self assert: (o instVarAt: #foo) equals: 1.
  2037. self assert: (o instVarAt: 'foo') equals: 1
  2038. !
  2039. testNilUndefined
  2040. "nil in Smalltalk is the undefined object in JS"
  2041. self assert: self notDefined equals: nil
  2042. !
  2043. testYourself
  2044. | o |
  2045. o := ObjectMock new.
  2046. self assert: o yourself == o
  2047. !
  2048. testidentityHash
  2049. | o1 o2 |
  2050. o1 := Object new.
  2051. o2 := Object new.
  2052. self assert: o1 identityHash == o1 identityHash.
  2053. self deny: o1 identityHash == o2 identityHash
  2054. ! !
  2055. TestCase subclass: #PointTest
  2056. instanceVariableNames: ''
  2057. package: 'Kernel-Tests'!
  2058. !PointTest methodsFor: 'tests'!
  2059. testAccessing
  2060. self assert: (Point x: 3 y: 4) x equals: 3.
  2061. self assert: (Point x: 3 y: 4) y equals: 4.
  2062. self assert: (Point new x: 3) x equals: 3.
  2063. self assert: (Point new y: 4) y equals: 4
  2064. !
  2065. testArithmetic
  2066. self assert: 3@4 * (3@4 ) equals: (Point x: 9 y: 16).
  2067. self assert: 3@4 + (3@4 ) equals: (Point x: 6 y: 8).
  2068. self assert: 3@4 - (3@4 ) equals: (Point x: 0 y: 0).
  2069. self assert: 6@8 / (3@4 ) equals: (Point x: 2 y: 2)
  2070. !
  2071. testAt
  2072. self assert: 3@4 equals: (Point x: 3 y: 4)
  2073. !
  2074. testComparison
  2075. self assert: 3@4 < (4@5).
  2076. self deny: 3@4 < (4@4).
  2077. self assert: 4@5 <= (4@5).
  2078. self deny: 4@5 <= (3@5).
  2079. self assert: 5@6 > (4@5).
  2080. self deny: 5@6 > (6@6).
  2081. self assert: 4@5 >= (4@5).
  2082. self deny: 4@5 >= (5@5)
  2083. !
  2084. testEgality
  2085. self assert: (3@4 = (3@4)).
  2086. self deny: 3@5 = (3@6)
  2087. !
  2088. testNew
  2089. self assert: (Point new x: 3) y equals: nil.
  2090. self deny: (Point new x: 3) x = 0.
  2091. self assert: (Point new y: 4) x equals: nil.
  2092. self deny: (Point new y: 4) y = 0
  2093. !
  2094. testTranslateBy
  2095. self assert: (3@3 translateBy: 0@1) equals: 3@4.
  2096. self assert: (3@3 translateBy: 0@1 negated) equals: 3@2.
  2097. self assert: (3@3 translateBy: 2@3) equals: 5@6.
  2098. self assert: (3@3 translateBy: 3 negated @0) equals: 0@3.
  2099. ! !
  2100. TestCase subclass: #QueueTest
  2101. instanceVariableNames: ''
  2102. package: 'Kernel-Tests'!
  2103. !QueueTest methodsFor: 'tests'!
  2104. testNextIfAbsent
  2105. | queue |
  2106. queue := Queue new.
  2107. queue nextPut: 'index1'.
  2108. self assert: (queue nextIfAbsent: 'empty') = 'index1'.
  2109. self deny: (queue nextIfAbsent: 'empty') = 'index1'
  2110. !
  2111. testQueueNext
  2112. | queue |
  2113. queue := Queue new.
  2114. queue
  2115. nextPut: 'index1';
  2116. nextPut: 'index2'.
  2117. self assert: queue next = 'index1'.
  2118. self deny: queue next = 'index'.
  2119. self should: [ queue next ] raise: Error
  2120. ! !
  2121. TestCase subclass: #RandomTest
  2122. instanceVariableNames: ''
  2123. package: 'Kernel-Tests'!
  2124. !RandomTest methodsFor: 'tests'!
  2125. testAtRandomNumber
  2126. |val|
  2127. 100 timesRepeat: [
  2128. val := 10 atRandom.
  2129. self assert: (val > 0).
  2130. self assert: (val <11)
  2131. ]
  2132. !
  2133. testAtRandomSequenceableCollection
  2134. |val|
  2135. 100 timesRepeat: [
  2136. val := 'abc' atRandom.
  2137. self assert: ((val = 'a') | (val = 'b') | (val = 'c' )).
  2138. ].
  2139. !
  2140. textNext
  2141. 10000 timesRepeat: [
  2142. | current next |
  2143. next := Random new next.
  2144. self assert: (next >= 0).
  2145. self assert: (next < 1).
  2146. self deny: current = next.
  2147. next = current ]
  2148. ! !
  2149. TestCase subclass: #StreamTest
  2150. instanceVariableNames: ''
  2151. package: 'Kernel-Tests'!
  2152. !StreamTest methodsFor: 'accessing'!
  2153. collectionClass
  2154. ^ self class collectionClass
  2155. !
  2156. newCollection
  2157. ^ self collectionClass new
  2158. !
  2159. newStream
  2160. ^ self collectionClass new stream
  2161. ! !
  2162. !StreamTest methodsFor: 'tests'!
  2163. testAtStartAtEnd
  2164. | stream |
  2165. stream := self newStream.
  2166. self assert: stream atStart.
  2167. self assert: stream atEnd.
  2168. stream nextPutAll: self newCollection.
  2169. self assert: stream atEnd.
  2170. self deny: stream atStart.
  2171. stream position: 1.
  2172. self deny: stream atEnd.
  2173. self deny: stream atStart
  2174. !
  2175. testContents
  2176. | stream |
  2177. stream := self newStream.
  2178. stream nextPutAll: self newCollection.
  2179. self assert: stream contents equals: self newCollection
  2180. !
  2181. testIsEmpty
  2182. | stream |
  2183. stream := self newStream.
  2184. self assert: stream isEmpty.
  2185. stream nextPutAll: self newCollection.
  2186. self deny: stream isEmpty
  2187. !
  2188. testPosition
  2189. | collection stream |
  2190. collection := self newCollection.
  2191. stream := self newStream.
  2192. stream nextPutAll: collection.
  2193. self assert: stream position equals: collection size.
  2194. stream position: 0.
  2195. self assert: stream position equals: 0.
  2196. stream next.
  2197. self assert: stream position equals: 1.
  2198. stream next.
  2199. self assert: stream position equals: 2
  2200. !
  2201. testReading
  2202. | stream collection |
  2203. collection := self newCollection.
  2204. stream := self newStream.
  2205. stream
  2206. nextPutAll: collection;
  2207. position: 0.
  2208. collection do: [ :each |
  2209. self assert: stream next equals: each ].
  2210. self assert: stream next isNil
  2211. !
  2212. testStreamContents
  2213. !
  2214. testWrite
  2215. | stream collection |
  2216. collection := self newCollection.
  2217. stream := self newStream.
  2218. collection do: [ :each | stream << each ].
  2219. self assert: stream contents equals: collection
  2220. !
  2221. testWriting
  2222. | stream collection |
  2223. collection := self newCollection.
  2224. stream := self newStream.
  2225. collection do: [ :each | stream nextPut: each ].
  2226. self assert: stream contents equals: collection.
  2227. stream := self newStream.
  2228. stream nextPutAll: collection.
  2229. self assert: stream contents equals: collection
  2230. ! !
  2231. !StreamTest class methodsFor: 'accessing'!
  2232. collectionClass
  2233. ^ nil
  2234. ! !
  2235. !StreamTest class methodsFor: 'testing'!
  2236. isAbstract
  2237. ^ self collectionClass isNil
  2238. ! !
  2239. StreamTest subclass: #ArrayStreamTest
  2240. instanceVariableNames: ''
  2241. package: 'Kernel-Tests'!
  2242. !ArrayStreamTest methodsFor: 'accessing'!
  2243. newCollection
  2244. ^ { true. 1. 3@4. 'foo' }
  2245. ! !
  2246. !ArrayStreamTest class methodsFor: 'accessing'!
  2247. collectionClass
  2248. ^ Array
  2249. ! !
  2250. StreamTest subclass: #StringStreamTest
  2251. instanceVariableNames: ''
  2252. package: 'Kernel-Tests'!
  2253. !StringStreamTest methodsFor: 'accessing'!
  2254. newCollection
  2255. ^ 'hello world'
  2256. ! !
  2257. !StringStreamTest class methodsFor: 'accessing'!
  2258. collectionClass
  2259. ^ String
  2260. ! !
  2261. TestCase subclass: #UndefinedTest
  2262. instanceVariableNames: ''
  2263. package: 'Kernel-Tests'!
  2264. !UndefinedTest methodsFor: 'tests'!
  2265. testCopying
  2266. self assert: nil copy equals: nil
  2267. !
  2268. testDeepCopy
  2269. self assert: nil deepCopy = nil
  2270. !
  2271. testIfNil
  2272. self assert: (nil ifNil: [ true ]) equals: true.
  2273. self deny: (nil ifNotNil: [ true ]) = true.
  2274. self assert: (nil ifNil: [ true ] ifNotNil: [ false ]) equals: true.
  2275. self deny: (nil ifNotNil: [ true ] ifNil: [ false ]) = true
  2276. !
  2277. testIsNil
  2278. self assert: nil isNil.
  2279. self deny: nil notNil.
  2280. ! !