Squeak-dev April 2019

squeak-dev@lists.squeakfoundation.org

36 participants
122 discussions

Help: fonts in PluggableTextSpec
by K K Subbu 20 May '19

20 May '19

Hi, PluggableTextSpec>>font returns a default font if font is not specified. This results in default font overriding any fonts in the plugged textmorphs :-( as in the case of Help->FontSizeSummary. The exact font to be used to render text should be determined lazily by textMorph and not in pluggable text spec. My proposed fix has a wide ranging effect, so I am posting it here for a critique before finalizing a patch to Inbox. Thanks and Regards .. Subbu

2 3

The Inbox: TraitsTests-pre.19.mcz
by commits＠source.squeak.org 04 May '19

04 May '19

Patrick Rein uploaded a new version of TraitsTests to project The Inbox: http://source.squeak.org/inbox/TraitsTests-pre.19.mcz ==================== Summary ==================== Name: TraitsTests-pre.19 Author: pre Time: 28 March 2019, 3:30:48.769796 pm UUID: 2ed07595-23e5-5f41-92ef-17c27ad0a017 Ancestors: TraitsTests-ul.18 Adds a test case for removing traits from a class by simply executing a class creation method without a trait composition. This does currently not yet work. =============== Diff against TraitsTests-ul.18 =============== Item was added: + ----- Method: TraitTest>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #(testRemoveTraitBySimpleClassDefinition)! Item was added: + ----- Method: TraitTest>>testRemoveTraitBySimpleClassDefinition (in category 'testing') ----- + testRemoveTraitBySimpleClassDefinition + + | classAv1 classAv2 | + classAv1 := self createClassNamed: #TraitTestMethodClassA superclass: Object uses: T1. + classAv2 := self createClassNamed: #TraitTestMethodClassA superclass: Object. + + self assert: classAv1 == classAv2. + self assert: classAv2 traits isEmpty.! Item was added: + ----- Method: TraitsTestCase>>createClassNamed:superclass: (in category 'utility') ----- + createClassNamed: aSymbol superclass: aClass + | class | + class := aClass + subclass: aSymbol + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self categoryName. + self createdClassesAndTraits add: class. + ^class!

10 18

The Inbox: Chronology-Core-cbc.41.mcz
by commits＠source.squeak.org 01 May '19

01 May '19

Chris Cunningham uploaded a new version of Chronology-Core to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-cbc.41.mcz ==================== Summary ==================== Name: Chronology-Core-cbc.41 Author: cbc Time: 22 April 2019, 8:58:13.835953 am UUID: 3d8013b6-d58f-004e-8e6b-5a59ed5841e7 Ancestors: Chronology-Core-dtl.40 We have the ability to change the starting day of the week (Week>>startDay:). This change adds #dayOfLocalWeek to DateAndTime and Timespan to return the indexed day of the week based on the altered starting day. Original #dayOfWeek is left as-is along with all other working code. =============== Diff against Chronology-Core-dtl.40 =============== Item was added: + ----- Method: DateAndTime>>dayOfLocalWeek (in category 'ansi protocol') ----- + dayOfLocalWeek + + "Sunday=1, ... , Saturday=7" + + ^ (self julianDayNumber + 2 - Week weekdayStartIndex rem: 7) + 1 + ! Item was added: + ----- Method: Timespan>>dayOfLocalWeek (in category 'ansi protocol') ----- + dayOfLocalWeek + "Answer the day of the week represented by the receiver." + + ^ start dayOfLocalWeek! Item was added: + ----- Method: Week class>>weekdayStartIndex (in category 'squeak protocol') ----- + weekdayStartIndex + ^self indexOfDay: self startDay!

5 7

The Trunk: CollectionsTests-pre.306.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-pre.306.mcz ==================== Summary ==================== Name: CollectionsTests-pre.306 Author: pre Time: 30 April 2019, 7:59:37.201906 pm UUID: 845c12d6-06a6-c641-b74b-b20354dd578e Ancestors: CollectionsTests-nice.305 Recategorizes test methods in CollectionsTests =============== Diff against CollectionsTests-nice.305 =============== Item was changed: + ----- Method: ArrayTest>>testEmpty (in category 'tests') ----- - ----- Method: ArrayTest>>testEmpty (in category 'testing') ----- testEmpty self assert: 0 equals: Array empty size description: 'The empty Array should be empty indeed'; assert: Array equals: Array empty species description: 'The empty Array should be an Array'; assert: Array empty identical: Array empty description: 'The empty Array should be canonical'; yourself ! Item was changed: + ----- Method: ArrayTest>>testIsArray (in category 'tests') ----- - ----- Method: ArrayTest>>testIsArray (in category 'testing') ----- testIsArray self assert: example1 isArray! Item was changed: + ----- Method: ArrayTest>>testIsLiteral (in category 'tests') ----- - ----- Method: ArrayTest>>testIsLiteral (in category 'testing') ----- testIsLiteral "We work with a copy of literalArray, to avoid corrupting the code." | aLiteralArray | aLiteralArray := literalArray copy. self assert: aLiteralArray isLiteral. aLiteralArray at: 1 put: self class. self deny: aLiteralArray isLiteral. self deny: (literalArray as: WeakArray) isLiteral description: 'instances of Array subclasses are not literal'.! Item was changed: + ----- Method: ArrayTest>>testLiteralEqual (in category 'tests') ----- - ----- Method: ArrayTest>>testLiteralEqual (in category 'testing') ----- testLiteralEqual self deny: (example1 literalEqual: example1 asIntegerArray)! Item was changed: + ----- Method: ArrayTest>>testLiteralStoreOn (in category 'tests') ----- - ----- Method: ArrayTest>>testLiteralStoreOn (in category 'testing') ----- testLiteralStoreOn "Test that a literal Array is stored and evaluated back unchanged" | anArray | anArray := {true. false. nil. #a. 'a'. $a. -1. 0. 1. Float pi. Float halfPi. Float halfPi negated.}. anArray := anArray copyWith: anArray. self assert: anArray isLiteral. self assert: (Compiler evaluate: anArray storeString) = anArray.! Item was changed: + ----- Method: ArrayTest>>testNewWithSize (in category 'tests') ----- - ----- Method: ArrayTest>>testNewWithSize (in category 'testing') ----- testNewWithSize |array| array := Array new: 5. self assert: array size = 5. 1 to: 5 do: [:index | self assert: (array at: index) isNil]! Item was changed: + ----- Method: ArrayTest>>testPremultiply (in category 'tests') ----- - ----- Method: ArrayTest>>testPremultiply (in category 'testing') ----- testPremultiply self assert: example1 +* #(2 ) = #(2 4 6 8 10 ) ! Item was changed: + ----- Method: ArrayTest>>testPrinting (in category 'tests') ----- - ----- Method: ArrayTest>>testPrinting (in category 'testing') ----- testPrinting self assert: '#(1 true 3 #four)' equals: literalArray printString. self assert: (literalArray = (Compiler evaluate: literalArray printString)) description: 'Literal array doesn''t print as a string that when evaluated returns an equivalent Array'. self assert: '{1 . true . (3/4) . Color black . (2 to: 4) . 5}' equals: selfEvaluatingArray printString. self assert: (selfEvaluatingArray = (Compiler evaluate: selfEvaluatingArray printString)) description: 'Array doesn''t print as a string that when evaluated returns an equivalent Array'. self assert: '{1 . a Set(1)}' equals: nonSEArray1 printString. self assert: '{#Array=>Array}' equals: nonSEarray2 printString. ! Item was changed: + ----- Method: Ascii85ConverterTest>>setUp (in category 'running') ----- - ----- Method: Ascii85ConverterTest>>setUp (in category 'initialize-release') ----- setUp self decoded: 'Hi There!!'. self encoded: '<~8802GBOu3q+T~>'.! Item was changed: + ----- Method: AssociationTest>>testStoreStringEvaluatesToEqualValue (in category 'tests') ----- - ----- Method: AssociationTest>>testStoreStringEvaluatesToEqualValue (in category 'as yet unclassified') ----- testStoreStringEvaluatesToEqualValue self assert: 1 -> 2 equals: (Compiler evaluate: (1 -> 2) storeString). self assert: false -> true equals: (Compiler evaluate: (false -> true) storeString). self assert: #foo -> #bar equals: (Compiler evaluate: (#foo -> #bar) storeString). self assert: #foo -> #+ equals: (Compiler evaluate: (#foo -> #+) storeString). self assert: #+ -> #bar equals: (Compiler evaluate: (#+ -> #bar) storeString).! Item was changed: + ----- Method: BagTest>>testAdd (in category 'tests - basic') ----- - ----- Method: BagTest>>testAdd (in category 'basic tests') ----- testAdd "self run: #testAdd" "self debug: #testAdd" | aBag | aBag := Bag new. aBag add: 'a'. aBag add: 'b'. self assert: aBag size = 2. aBag add: 'a'. self assert: aBag size = 3. self assert: (aBag occurrencesOf: 'a') = 2 ! Item was changed: + ----- Method: BagTest>>testAddWithOccurrences (in category 'tests - basic') ----- - ----- Method: BagTest>>testAddWithOccurrences (in category 'basic tests') ----- testAddWithOccurrences "self debug:#testAddWithOccurrences" | aBag | aBag := Bag new. aBag add: 'a' withOccurrences: 3. self assert: (aBag size = 3). ! Item was changed: + ----- Method: BagTest>>testAsBag (in category 'tests - basic') ----- - ----- Method: BagTest>>testAsBag (in category 'basic tests') ----- testAsBag | aBag | aBag := Bag new. self assert: aBag asBag = aBag.! Item was changed: + ----- Method: BagTest>>testAsSet (in category 'tests - basic') ----- - ----- Method: BagTest>>testAsSet (in category 'basic tests') ----- testAsSet | aBag aSet | aBag := Bag new. aBag add:'a' withOccurrences: 4. aBag add:'b' withOccurrences: 2. aSet := aBag asSet. self assert: aSet size = 2. self assert: (aSet occurrencesOf: 'a') = 1 ! Item was changed: + ----- Method: BagTest>>testCopy (in category 'tests - basic') ----- - ----- Method: BagTest>>testCopy (in category 'basic tests') ----- testCopy "self run: #testCopy" | aBag newBag | aBag := Bag new. aBag add:'a' withOccurrences: 4. aBag add:'b' withOccurrences: 2. newBag := aBag copy. self assert: newBag = newBag. self assert: newBag asSet size = 2.! Item was changed: + ----- Method: BagTest>>testOccurrencesOf (in category 'tests - basic') ----- - ----- Method: BagTest>>testOccurrencesOf (in category 'basic tests') ----- testOccurrencesOf "self debug: #testOccurrencesOf" | aBag | aBag := Bag new. aBag add: 'a' withOccurrences: 3. aBag add: 'b'. aBag add: 'b'. aBag add: 'b'. aBag add: 'b'. self assert: (aBag occurrencesOf:'a') = 3. self assert: (aBag occurrencesOf:'b') = 4. self assert: (aBag occurrencesOf:'c') = 0. self assert: (aBag occurrencesOf: nil) =0. aBag add: nil. self assert: (aBag occurrencesOf: nil) =1. ! Item was changed: + ----- Method: Base64MimeConverterTest>>setUp (in category 'running') ----- - ----- Method: Base64MimeConverterTest>>setUp (in category 'initialize-release') ----- setUp message := 'Hi There!!' readStream. ! Item was changed: + ----- Method: BitSetTest>>testBitManipulationAPI (in category 'tests') ----- - ----- Method: BitSetTest>>testBitManipulationAPI (in category 'testing') ----- testBitManipulationAPI #(0 8 16 24 32) do: [ :each | self testBitManipulationAPI: each ]! Item was changed: + ----- Method: BitSetTest>>testBitManipulationAPI: (in category 'tests') ----- - ----- Method: BitSetTest>>testBitManipulationAPI: (in category 'testing') ----- testBitManipulationAPI: capacity self initializeBitset: capacity. 0 to: capacity - 1 do: [ :index | self assert: 0 equals: (bitset bitAt: index). self assert: #() equals: self bitsetElements. self assert: false equals: (bitset clearBitAt: index). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: false equals: (bitset clearBitAt: index). self assert: true equals: (bitset setBitAt: index). self assert: 1 equals: (bitset bitAt: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: false equals: (bitset setBitAt: index). self assert: 1 equals: (bitset bitAt: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: true equals: (bitset clearBitAt: index). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset bitAt: index). self assert: false equals: (bitset clearBitAt: index). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset bitAt: index). self assert: capacity equals: bitset capacity ]. self should: [ bitset bitAt: -1 ] raise: Error; should: [ bitset bitAt: capacity ] raise: Error. self should: [ bitset setBitAt: -1 ] raise: Error; should: [ bitset setBitAt: capacity ] raise: Error. self should: [ bitset clearBitAt: -1 ] raise: Error; should: [ bitset clearBitAt: capacity ] raise: Error! Item was changed: + ----- Method: BitSetTest>>testCopy (in category 'tests') ----- - ----- Method: BitSetTest>>testCopy (in category 'testing') ----- testCopy #(0 8 16 24 32) do: [ :each | self testCopy: each ]! Item was changed: + ----- Method: BitSetTest>>testCopy: (in category 'tests') ----- - ----- Method: BitSetTest>>testCopy: (in category 'testing') ----- testCopy: n | copy | self initializeBitset: n. copy := bitset copy. self assert: copy equals: bitset. self assert: copy hash equals: bitset hash. self deny: bitset == copy. self deny: bitset bytes == copy bytes! Item was changed: + ----- Method: BitSetTest>>testDictionaryAPI (in category 'tests') ----- - ----- Method: BitSetTest>>testDictionaryAPI (in category 'testing') ----- testDictionaryAPI #(0 8 16 24 32) do: [ :each | self testDictionaryAPI: each ]! Item was changed: + ----- Method: BitSetTest>>testDictionaryAPI: (in category 'tests') ----- - ----- Method: BitSetTest>>testDictionaryAPI: (in category 'testing') ----- testDictionaryAPI: capacity self initializeBitset: capacity. 0 to: capacity - 1 do: [ :index | self assert: 0 equals: (bitset at: index). self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset at: index put: 0). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset at: index put: 0). self assert: 1 equals: (bitset at: index put: 1). self assert: 1 equals: (bitset at: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: 1 equals: (bitset at: index put: 1). self assert: 1 equals: (bitset at: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: 0 equals: (bitset at: index put: 0). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset at: index). self assert: 0 equals: (bitset at: index put: 0). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: 0 equals: (bitset at: index). self assert: capacity equals: bitset capacity ]. self should: [ bitset at: capacity ] raise: Error; should: [ bitset at: capacity put: 0 ] raise: Error; should: [ bitset at: capacity put: 1 ] raise: Error. self should: [ bitset at: -1 ] raise: Error; should: [ bitset at: -1 put: 0 ] raise: Error; should: [ bitset at: -1 put: 1 ] raise: Error. self should: [ bitset at: 0 put: -1 ] raise: Error; should: [ bitset at: 0 put: 2 ] raise: Error; should: [ bitset at: 0 put: nil ] raise: Error! Item was changed: + ----- Method: BitSetTest>>testNew (in category 'tests') ----- - ----- Method: BitSetTest>>testNew (in category 'testing') ----- testNew self should: [ Bitset new ] raise: Error! Item was changed: + ----- Method: BitSetTest>>testRemoveAll (in category 'tests') ----- - ----- Method: BitSetTest>>testRemoveAll (in category 'testing') ----- testRemoveAll #(0 8 16 24 32) do: [ :each | self testRemoveAll: each ]! Item was changed: + ----- Method: BitSetTest>>testRemoveAll: (in category 'tests') ----- - ----- Method: BitSetTest>>testRemoveAll: (in category 'testing') ----- testRemoveAll: n self initializeBitset: n. 0 to: n - 1 do: [ :index | bitset setBitAt: index ]. self assert: n equals: bitset size. self assert: (bitset bytes allSatisfy: [ :each | each = 255 ]). bitset removeAll. self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self assert: (bitset bytes allSatisfy: [ :each | each = 0 ]). ! Item was changed: + ----- Method: BitSetTest>>testSetAPI (in category 'tests') ----- - ----- Method: BitSetTest>>testSetAPI (in category 'testing') ----- testSetAPI #(0 8 16 24 32) do: [ :each | self testSetAPI: each ]! Item was changed: + ----- Method: BitSetTest>>testSetAPI: (in category 'tests') ----- - ----- Method: BitSetTest>>testSetAPI: (in category 'testing') ----- testSetAPI: capacity self initializeBitset: capacity. self assert: capacity equals: capacity // 8 * 8 description: 'capacity must be a multiple of eight.'. self assert: capacity equals: bitset capacity. self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. 0 to: capacity - 1 do: [ :index | self deny: (bitset includes: index). self assert: #() equals: self bitsetElements. self assert: nil equals: (bitset remove: index ifAbsent: [ nil ]). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self deny: (bitset includes: index). self assert: index equals: (bitset add: index). self assert: (bitset includes: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: index equals: (bitset add: index). self assert: (bitset includes: index). self assert: 1 equals: bitset size. self assert: { index } equals: self bitsetElements. self assert: index equals: (bitset remove: index). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self deny: (bitset includes: index). self assert: nil equals: (bitset remove: index ifAbsent: [ nil ]). self assert: 0 equals: bitset size. self assert: #() equals: self bitsetElements. self deny: (bitset includes: index). self assert: capacity equals: bitset capacity ]. self deny: (bitset includes: -1); deny: (bitset includes: capacity). self should: [ bitset add: capacity ] raise: Error; should: [ bitset add: -1 ] raise: Error; should: [ bitset remove: capacity ] raise: Error; should: [ bitset remove: -1 ] raise: Error! Item was changed: + ----- Method: BitSetTest>>testSize (in category 'tests') ----- - ----- Method: BitSetTest>>testSize (in category 'testing') ----- testSize #(0 8 16 24 32) do: [ :each | self testSize: each ]! Item was changed: + ----- Method: BitSetTest>>testSize: (in category 'tests') ----- - ----- Method: BitSetTest>>testSize: (in category 'testing') ----- testSize: n self initializeBitset: n. 0 to: n - 1 do: [ :index | self assert: index equals: bitset size. bitset setBitAt: index ]. self assert: n equals: bitset size. 0 to: n - 1 do: [ :index | self assert: n - index equals: bitset size. bitset clearBitAt: index ]. self assertBitsetIsEmpty! Item was changed: + ----- Method: ByteArrayTest>>byteArrayFor:bits:bigEndian: (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>byteArrayFor:bits:bigEndian: (in category 'testing - platform independent access') ----- byteArrayFor: signedValue bits: bits bigEndian: bigEndian | unsignedValue size result | unsignedValue := signedValue negative ifTrue: [ signedValue + (1 bitShift: bits) ] ifFalse: [ signedValue ]. size := bits // 8. result := ByteArray new: size. 1 to: size do: [ :index | result at: index put: (unsignedValue digitAt: index) ]. bigEndian ifTrue: [ result reverseInPlace ]. ^result ! Item was changed: + ----- Method: ByteArrayTest>>testEmpty (in category 'tests') ----- - ----- Method: ByteArrayTest>>testEmpty (in category 'testing') ----- testEmpty self assert: 0 equals: ByteArray empty size description: 'The empty ByteArray should be empty indeed'; assert: ByteArray equals: ByteArray empty species description: 'The empty ByteArray should be a ByteArray'; assert: ByteArray empty identical: ByteArray empty description: 'The empty ByteArray should be canonical'; yourself ! Item was changed: + ----- Method: ByteArrayTest>>testFallbackReplaceFromToWith (in category 'tests') ----- - ----- Method: ByteArrayTest>>testFallbackReplaceFromToWith (in category 'testing') ----- testFallbackReplaceFromToWith | teststring ba sz cm | teststring := 'Test string' asByteArray. sz := teststring byteSize. ba := ByteArray new: sz. cm := SequenceableCollection compiledMethodAt: #replaceFrom:to:with:startingAt:. self shouldnt: [cm valueWithReceiver: ba arguments: {1. sz. teststring. 1}] raise: Exception description: 'Primitive 105 should be optional for ByteArray' ! Item was changed: + ----- Method: ByteArrayTest>>testHex (in category 'tests - hex') ----- - ----- Method: ByteArrayTest>>testHex (in category 'hex tests') ----- testHex self assert: #[122 43 213 7] hex = '7a2bd507'. self assert: (UUID fromString: '97c1f2dd-f920-9948-b329-319a30c16386') hex = '97c1f2ddf9209948b329319a30c16386'.! Item was changed: + ----- Method: ByteArrayTest>>testIsLiteral (in category 'tests - hex') ----- - ----- Method: ByteArrayTest>>testIsLiteral (in category 'hex tests') ----- testIsLiteral self assert: #[122 43 213 7] isLiteral description: 'ByteArray instances are literal'. self deny: thisContext method isLiteral description: 'ByteArray sub instances are not literal'! Item was changed: + ----- Method: ByteArrayTest>>testPlatformIndepentendIntegerAccessorsAtBitBorders (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>testPlatformIndepentendIntegerAccessorsAtBitBorders (in category 'testing - platform independent access') ----- testPlatformIndepentendIntegerAccessorsAtBitBorders #( shortAt:put:bigEndian: shortAt:bigEndian: false 16 longAt:put:bigEndian: longAt:bigEndian: false 32 long64At:put:bigEndian: long64At:bigEndian: false 64 unsignedShortAt:put:bigEndian: unsignedShortAt:bigEndian: true 16 unsignedLongAt:put:bigEndian: unsignedLongAt:bigEndian: true 32 unsignedLong64At:put:bigEndian: unsignedLong64At:bigEndian: true 64 ) groupsDo: [ :setter :getter :unsigned :storageBits | self verifyPlatformIndepentendIntegerAccessorsAtBitBordersSetter: setter getter: getter unsigned: unsigned storageBits: storageBits ]! Item was changed: + ----- Method: ByteArrayTest>>testPlatformIndepentendIntegerAccessorsWithRandomValues (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>testPlatformIndepentendIntegerAccessorsWithRandomValues (in category 'testing - platform independent access') ----- testPlatformIndepentendIntegerAccessorsWithRandomValues | random | random := Random seed: 36rSqueak. #( shortAt:put:bigEndian: shortAt:bigEndian: false 16 longAt:put:bigEndian: longAt:bigEndian: false 32 long64At:put:bigEndian: long64At:bigEndian: false 64 unsignedShortAt:put:bigEndian: unsignedShortAt:bigEndian: true 16 unsignedLongAt:put:bigEndian: unsignedLongAt:bigEndian: true 32 unsignedLong64At:put:bigEndian: unsignedLong64At:bigEndian: true 64 ) groupsDo: [ :setter :getter :unsigned :storageBits | self verifyPlatformIndepentendIntegerAccessorsWithRandomValuesSetter: setter getter: getter unsigned: unsigned storageBits: storageBits random: random ]! Item was changed: + ----- Method: ByteArrayTest>>testReadHexFrom (in category 'tests - hex') ----- - ----- Method: ByteArrayTest>>testReadHexFrom (in category 'hex tests') ----- testReadHexFrom self assert: (ByteArray readHexFrom: '7a2bd507') = #[122 43 213 7]. self assert: (UUID readHexFrom: '97c1f2ddf9209948b329319a30c16386') = (UUID fromString: '97c1f2dd-f920-9948-b329-319a30c16386').! Item was changed: + ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsAtBitBordersSetter:getter:unsigned:storageBits: (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsAtBitBordersSetter:getter:unsigned:storageBits: (in category 'testing - platform independent access') ----- verifyPlatformIndepentendIntegerAccessorsAtBitBordersSetter: setter getter: getter unsigned: unsigned storageBits: storageBits | byteArray minValue maxValue baseValues | byteArray := ByteArray new: storageBits // 8 * 2. unsigned ifTrue: [ minValue := 0. maxValue := 1 << storageBits - 1. baseValues := #(0 1) ] ifFalse: [ minValue := -1 << (storageBits - 1). maxValue := 1 << (storageBits - 1) - 1. baseValues := #(-1 0 1) ]. #(true false) do: [ :bigEndian | 0 to: storageBits - 1 do: [ :bits | baseValues do: [ :baseValue | | centerValue | centerValue := baseValue << bits. centerValue - 1 to: centerValue + 1 do: [ :value | (value between: minValue and: maxValue) ifTrue: [ self verifyPlatformIndepentendIntegerAccessorsMatch: byteArray for: value setter: setter getter: getter storageBits: storageBits bigEndian: bigEndian ] ] ] ] ] ! Item was changed: + ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsMatch:for:setter:getter:storageBits:bigEndian: (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsMatch:for:setter:getter:storageBits:bigEndian: (in category 'testing - platform independent access') ----- verifyPlatformIndepentendIntegerAccessorsMatch: byteArray for: value setter: setter getter: getter storageBits: storageBits bigEndian: bigEndian | expectedSetterResult getterResult bytes | expectedSetterResult := self byteArrayFor: value bits: storageBits bigEndian: bigEndian. bytes := storageBits // 8. 1 to: byteArray size - bytes + 1 do: [ :index | byteArray perform: setter with: index with: value with: bigEndian. 1 to: bytes do: [ :byteIndex | self assert: (expectedSetterResult at: byteIndex) equals: (byteArray at: index + byteIndex - 1) ]. getterResult := byteArray perform: getter with: index with: bigEndian. self assert: value equals: getterResult ]! Item was changed: + ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsWithRandomValuesSetter:getter:unsigned:storageBits:random: (in category 'tests - platform independent access') ----- - ----- Method: ByteArrayTest>>verifyPlatformIndepentendIntegerAccessorsWithRandomValuesSetter:getter:unsigned:storageBits:random: (in category 'testing - platform independent access') ----- verifyPlatformIndepentendIntegerAccessorsWithRandomValuesSetter: setter getter: getter unsigned: unsigned storageBits: storageBits random: random | byteArray randomMax randomOffset | byteArray := ByteArray new: storageBits // 8 * 2. randomMax := 1 << storageBits. randomOffset := unsigned ifTrue: [ -1 ] ifFalse: [ -1 << (storageBits - 1) - 1 ]. 10000 timesRepeat: [ | value | value := (random nextInt: randomMax) + randomOffset. #(true false) do: [ :bigEndian | self verifyPlatformIndepentendIntegerAccessorsMatch: byteArray for: value setter: setter getter: getter storageBits: storageBits bigEndian: bigEndian ] ]! Item was changed: + ----- Method: CharacterSetComplementTest>>testIncludes (in category 'tests') ----- - ----- Method: CharacterSetComplementTest>>testIncludes (in category 'testing') ----- testIncludes | set complement | set := 'abc' as: CharacterSet. complement := set complement. self assert: (set noneSatisfy: [:e | complement includes: e]). self assert: (($d to: $z) allSatisfy: [:e | complement includes: e]).! Item was changed: + ----- Method: CharacterSetComplementTest>>testPrintString (in category 'tests') ----- - ----- Method: CharacterSetComplementTest>>testPrintString (in category 'testing') ----- testPrintString |s| s := CharacterSet separators complement printString. self assert: (s includesSubstring: 'complement') description: 'Doesn''t describe its fundamental characteristic'. self assert: (s includesSubstring: 'Character space') description: 'Doesn''t mention an important separator'.! Item was changed: + ----- Method: CharacterSetComplementTest>>testReject (in category 'tests') ----- - ----- Method: CharacterSetComplementTest>>testReject (in category 'testing') ----- testReject | set complement subset | set := 'abc' as: CharacterSet. complement := set complement. subset := complement reject: [:c | c isVowel]. self assert: (subset includes: $z). "Not a vowel, it is in the subset" self deny: (subset includes: $e). "a vowel should be rejected" self deny: (subset includes: $b). "Not a vowel, but not in the original set"! Item was changed: + ----- Method: CharacterSetComplementTest>>testSelect (in category 'tests') ----- - ----- Method: CharacterSetComplementTest>>testSelect (in category 'testing') ----- testSelect | set complement digits | set := 'abc012' as: CharacterSet. complement := set complement. digits := complement select: [:c | c isDigit]. self assert: (digits includes: $9). self deny: (digits includes: $1). self deny: (digits includes: $z).! Item was changed: + ----- Method: CharacterSetTest>>testComplement (in category 'tests') ----- - ----- Method: CharacterSetTest>>testComplement (in category 'testing') ----- testComplement | set complement | set := 'abc' as: CharacterSet. complement := set complement. self assert: (set noneSatisfy: [:e | complement includes: e]). self assert: (($d to: $z) allSatisfy: [:e | complement includes: e]).! Item was changed: + ----- Method: CharacterSetTest>>testCopy (in category 'tests') ----- - ----- Method: CharacterSetTest>>testCopy (in category 'testing') ----- testCopy | theOriginal theCopy | theOriginal := CharacterSet newFrom: 'abc'. theCopy := theOriginal copy. theCopy remove: $a. ^self assert: (theOriginal includes: $a) description: 'Changing the copy should not change the original'.! Item was changed: + ----- Method: CharacterSetTest>>testIncludes (in category 'tests') ----- - ----- Method: CharacterSetTest>>testIncludes (in category 'testing') ----- testIncludes | set | set := 'abc' as: CharacterSet. self assert: (($a to: $c) allSatisfy: [:e | set includes: e]). self assert: (($d to: $z) noneSatisfy: [:e | set includes: e]).! Item was changed: + ----- Method: CharacterSetTest>>testIntersection (in category 'tests') ----- - ----- Method: CharacterSetTest>>testIntersection (in category 'testing') ----- testIntersection | intersection | intersection := ('abc' as: CharacterSet) intersection: ('bcde' as: CharacterSet). self assert: intersection = ('bc' as: CharacterSet)! Item was changed: + ----- Method: CharacterSetTest>>testIntersectionWithComplement (in category 'tests') ----- - ----- Method: CharacterSetTest>>testIntersectionWithComplement (in category 'testing') ----- testIntersectionWithComplement | intersection intersection2 | intersection := ('abcd' as: CharacterSet) intersection: ('cdef' as: CharacterSet) complement. self assert: intersection = ('ab' as: CharacterSet). intersection2 := ('cdef' as: CharacterSet) complement intersection: ('abcd' as: CharacterSet). self assert: intersection2 = intersection. "Intersection is symmetric"! Item was changed: + ----- Method: CharacterSetTest>>testUnion (in category 'tests') ----- - ----- Method: CharacterSetTest>>testUnion (in category 'testing') ----- testUnion | union | union := ('abc' as: CharacterSet) union: ('bcde' as: CharacterSet). self assert: union = ('abcde' as: CharacterSet)! Item was changed: + ----- Method: CharacterSetTest>>testUnionWithComplement (in category 'tests') ----- - ----- Method: CharacterSetTest>>testUnionWithComplement (in category 'testing') ----- testUnionWithComplement | union union2 | union := ('abc' as: CharacterSet) union: ('bcde' as: CharacterSet) complement. self assert: union = ('de' as: CharacterSet) complement. union2 := ('bcde' as: CharacterSet) complement union: ('abc' as: CharacterSet). self assert: union2 = union. "union is symmetric"! Item was changed: + ----- Method: DictionaryTest>>testAddAssociation (in category 'tests - association') ----- - ----- Method: DictionaryTest>>testAddAssociation (in category 'association tests') ----- testAddAssociation "self run:#testAddAssociation" "self debug:#testAddAssociation" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict at: #a) = 1. self assert: (dict at: #b) = 2. dict at: #a put: 10. dict at: #c put: 2. self assert: (dict at: #a) = 10. self assert: (dict at: #b) = 2. self assert: (dict at: #c) = 2 ! Item was changed: + ----- Method: DictionaryTest>>testAssociationsSelect (in category 'tests - association') ----- - ----- Method: DictionaryTest>>testAssociationsSelect (in category 'association tests') ----- testAssociationsSelect | answer d | d := Dictionary new. d at: (Array with: #hello with: #world) put: #fooBar. d at: Smalltalk put: #'Smalltalk is the key'. d at: #Smalltalk put: Smalltalk. answer := d associationsSelect: [:assoc | assoc key == #Smalltalk and: [assoc value == Smalltalk]]. self should: [answer isKindOf: Dictionary]. self should: [answer size = 1]. self should: [(answer at: #Smalltalk) == Smalltalk]. answer := d associationsSelect: [:assoc | assoc key == #NoSuchKey and: [assoc value == #NoSuchValue]]. self should: [answer isKindOf: Dictionary]. self should: [answer size = 0]! Item was changed: + ----- Method: DictionaryTest>>testAtError (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtError (in category 'basic tests') ----- testAtError "self run: #testAtError" | dict | dict := Dictionary new. dict at: #a put: 666. self shouldnt: [ dict at: #a ] raise: KeyNotFound. self should: [ dict at: #b ] raise: KeyNotFound. ! Item was changed: + ----- Method: DictionaryTest>>testAtIfAbsent (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtIfAbsent (in category 'basic tests') ----- testAtIfAbsent "self run: #testAtIfAbsent" | dict | dict := Dictionary new. dict at: #a put: 666. self assert: (dict at: #a ifAbsent: [nil]) = 666. self assert: (dict at: #b ifAbsent: [nil]) isNil. ! Item was changed: + ----- Method: DictionaryTest>>testAtIfPresentIfAbsent (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtIfPresentIfAbsent (in category 'basic tests') ----- testAtIfPresentIfAbsent "Test at:ifPresent:ifAbsent:" | dict present absent | dict := Dictionary new. present := absent := false. dict at: #foo ifPresent:[:v| present := true] ifAbsent:[absent := true]. self deny: present. self assert: absent. dict at: #foo put: #bar. present := absent := false. dict at: #foo ifPresent:[:v| present := true] ifAbsent:[absent := true]. self assert: present. self deny: absent. present := absent := false. dict at: #foo ifPresent:[:v| present := true. nil] ifAbsent:[absent := true]. self assert: present. self deny: absent. ! Item was changed: + ----- Method: DictionaryTest>>testAtIfPresentIfAbsentPut (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtIfPresentIfAbsentPut (in category 'basic tests') ----- testAtIfPresentIfAbsentPut "Test at:ifPresent:ifAbsentPut:" | dict present absent | dict := Dictionary new. present := absent := false. self assert: (dict at: #foo ifPresent:[:v| present := true. v] ifAbsentPut:[absent := true. #present]) equals: #present. self deny: present. self assert: absent. present := absent := false. self assert: (dict at: #foo ifPresent:[:v| present := true. v] ifAbsentPut:[absent := true. #absent]) equals: #present. self assert: present. self deny: absent.! Item was changed: + ----- Method: DictionaryTest>>testAtNil (in category 'tests - implementation') ----- - ----- Method: DictionaryTest>>testAtNil (in category 'implementation tests') ----- testAtNil "(self run: #testAtNil)" "nil is a valid key in squeak. In VW nil is not a valid key" "Ansi 1.9 p, 168 5.7.2.5 Message: at: key put: newElement Synopsis Store newElement at key in the receiver. Answer newElement. Definition: <abstractDictionary> If lookup succeeds for key, then newElement replaces the element previously stored at key. Otherwise, the newElement is stored at the new key. In either case, subsequent successful lookups for key will answer newElement. Answer newElement. The result is undefined if the key is nil. This clearly indicates that different smalltalks where doing different assumptions." | dict1 | dict1 := Dictionary new. dict1 at: nil put: #none. self assert: (dict1 at: nil) = #none. ! Item was changed: + ----- Method: DictionaryTest>>testAtPut (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtPut (in category 'basic tests') ----- testAtPut "self run: #testAtPut" "self debug: #testAtPut" | adictionary | adictionary := Dictionary new. adictionary at: #a put: 3. self assert: (adictionary at: #a) = 3. adictionary at: #a put: 3. adictionary at: #a put: 4. self assert: (adictionary at: #a) = 4. adictionary at: nil put: 666. self assert: (adictionary at: nil) = 666! Item was changed: + ----- Method: DictionaryTest>>testAtPutNil (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testAtPutNil (in category 'basic tests') ----- testAtPutNil "self run: #testAtPut" "self debug: #testAtPut" | dict | dict := Dictionary new. dict at: nil put: 1. self assert: (dict at: nil) = 1. dict at: #a put: nil. self assert: (dict at: #a) = nil. dict at: nil put: nil. self assert: (dict at: nil) = nil. ! Item was changed: + ----- Method: DictionaryTest>>testCollect (in category 'tests - collection protocol') ----- - ----- Method: DictionaryTest>>testCollect (in category 'testing') ----- testCollect "Ensure that Dictionary>>collect: answers a dictionary not something else" | dict expected result | dict := Dictionary newFromPairs:{ #first. 1. #second. 2. #third. 3. #fourth. 4. #fifth. 5. }. result := dict collect:[:each| each asWords]. expected := Dictionary newFromPairs:{ #first. 'one'. #second. 'two'. #third. 'three'. #fourth. 'four'. #fifth. 'five'. }. self assert: result = expected.! Item was changed: + ----- Method: DictionaryTest>>testDictionaryConcatenation (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testDictionaryConcatenation (in category 'keys and value tests') ----- testDictionaryConcatenation "self run: #testDictionaryConcatenation" | dict1 dict2 dict3 | dict1 := Dictionary new. dict1 at: #a put: 'Nicolas' ; at: #b put: 'Damien'. dict2 := Dictionary new. dict2 at: #a put: 'Christophe' ; at: #c put: 'Anthony'. dict3 := dict1, dict2. self assert: (dict3 at: #a) = 'Christophe'. self assert: (dict3 at: #b) = 'Damien'. self assert: (dict3 at: #c) = 'Anthony'. ! Item was changed: + ----- Method: DictionaryTest>>testIncludesAssociation (in category 'tests - association') ----- - ----- Method: DictionaryTest>>testIncludesAssociation (in category 'association tests') ----- testIncludesAssociation "self run:#testIncludesAssociation" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict includesAssociation: (#a -> 1)). self assert: (dict includesAssociation: (#b -> 2)). ! Item was changed: + ----- Method: DictionaryTest>>testIncludesAssociationNoValue (in category 'tests - association') ----- - ----- Method: DictionaryTest>>testIncludesAssociationNoValue (in category 'association tests') ----- testIncludesAssociationNoValue "self run:#testIncludesAssociationNoValue" "self debug:#testIncludesAssociationNoValue" | dict a1 a3 | a1 := Association key: #Italie. a3 := Association key: #France value: 'Paris'. self assert: (a1 key = #Italie). self assert: (a1 value isNil). dict := Dictionary new. dict add: a1. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: #Italie). self assert: (dict at: #Italie) isNil. self assert: (dict at: #France) = 'Paris' ! Item was changed: + ----- Method: DictionaryTest>>testIncludesKey (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testIncludesKey (in category 'basic tests') ----- testIncludesKey "self run:#testIncludesKey" "self debug:#testIncludesKey" | dict a1 a2 a3 | a1 := Association key: 'Italie'. a2 := Association new. a3 := Association key: 'France' value: 'Paris'. dict := Dictionary new. dict add: a1 . dict add: a2. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: 'France'). self assert: (dict includesKey: #Italie). self assert: (dict includesKey: nil). self assert: (dict at: 'France' ) = 'Paris'. ! Item was changed: + ----- Method: DictionaryTest>>testIntegrityOfDictionaries (in category 'tests - integrity') ----- - ----- Method: DictionaryTest>>testIntegrityOfDictionaries (in category 'integrity tests') ----- testIntegrityOfDictionaries #( Dictionary IdentityDictionary SystemDictionary LiteralDictionary PluggableDictionary WeakValueDictionary) do: [ :dictionaryClassName | Smalltalk at: dictionaryClassName ifPresent: [ :dictionaryClass | dictionaryClass allInstancesDo: [ :dictionary | dictionary keysAndValuesDo: [ :key :value | self assert: (dictionary at: key) == value ]. dictionary array doWithIndex: [ :association :index | association ifNotNil: [ self assert: (dictionary scanFor: association key) = index ] ] ] ] ]! Item was changed: + ----- Method: DictionaryTest>>testKeyAtValue (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testKeyAtValue (in category 'keys and value tests') ----- testKeyAtValue "self run: #testKeyAtValue" "self debug: #testKeyAtValue" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. self assert: (dict keyAtValue: 2) = #b. "which ever is answered depends on hashing, and hashing is improved in Spur." self assert: ((dict keyAtValue: 1) = #a or: [(dict keyAtValue: 1) = #c]). "ugly may be a bug, why not have a set #a and #c? cuz that would be keys at value." self should: [dict keyAtValue: 0] raise: Error ! Item was changed: + ----- Method: DictionaryTest>>testKeys (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testKeys (in category 'keys and value tests') ----- testKeys "self run:#testKeys " | a1 a2 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := Dictionary new. dict add: a1. dict add: a2. self assert: (dict keys size) = 2. self assert: (dict keys includes: #France) ! Item was changed: + ----- Method: DictionaryTest>>testKeysDo (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testKeysDo (in category 'keys and value tests') ----- testKeysDo "self run: #testKeysDo" "self debug: #testKeysDo" | dict res | dict := Dictionary new. dict at: #a put: 33. dict at: #b put: 66. res := OrderedCollection new. dict keysDo: [ :each | res add: each]. self assert: res asSet = #(a b) asSet. ! Item was changed: + ----- Method: DictionaryTest>>testMethodDictionaries (in category 'tests - integrity') ----- - ----- Method: DictionaryTest>>testMethodDictionaries (in category 'integrity tests') ----- testMethodDictionaries MethodDictionary allInstancesDo: [ :dictionary | dictionary keysAndValuesDo: [ :key :value | self assert: (dictionary at: key) == value ]. 1 to: dictionary basicSize do: [ :index | (dictionary basicAt: index) ifNil: [ self assert: (dictionary array at: index) isNil ] ifNotNil: [ :key | self assert: (dictionary scanFor: key) = index ] ] ]! Item was changed: + ----- Method: DictionaryTest>>testNewFromIsolation (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testNewFromIsolation (in category 'basic tests') ----- testNewFromIsolation "self run:#testNewFromIsolation" "self debug:#testNewFromIsolation" | dict1 dict2 | dict1 := Dictionary new. dict1 at: #one put: 'foo'; at: #two put: 0@0. dict2 := Dictionary newFrom: dict1. dict2 at: #one put: 'bar'. self assert: (dict1 at: #one) = 'foo'. ! Item was changed: + ----- Method: DictionaryTest>>testOccurrencesOf (in category 'tests - basic') ----- - ----- Method: DictionaryTest>>testOccurrencesOf (in category 'basic tests') ----- testOccurrencesOf "self run:#testOccurrencesOf" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. dict at: #d put: 3. dict at: nil put: nil. dict at: #z put: nil. self assert: (dict occurrencesOf: 1 ) = 2. self assert: (dict occurrencesOf: nil ) = 2. ! Item was changed: + ----- Method: DictionaryTest>>testPseudoVariablesAreValidKeys (in category 'tests - implementation') ----- - ----- Method: DictionaryTest>>testPseudoVariablesAreValidKeys (in category 'implementation tests') ----- testPseudoVariablesAreValidKeys "(self run: #testPseudoVariablesAreValidKeys)" "true and false are valid keys" | dict1 | dict1 := Dictionary new. dict1 at: true put: #true. self assert: (dict1 at: true) = #true. dict1 at: false put: #false. self assert: (dict1 at: false) = #false.! Item was changed: + ----- Method: DictionaryTest>>testReject (in category 'tests - collection protocol') ----- - ----- Method: DictionaryTest>>testReject (in category 'testing') ----- testReject "Ensure that Dictionary>>reject: answers a dictionary not something else" | dict expected result | dict := Dictionary newFromPairs:{ #first. 1. #second. 2. #third. 3. #fourth. 4. #fifth. 5. }. result := dict reject:[:each| each odd]. expected := Dictionary newFromPairs:{ #second. 2. #fourth. 4. }. self assert: result = expected.! Item was changed: + ----- Method: DictionaryTest>>testRemoveKey (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testRemoveKey (in category 'keys and value tests') ----- testRemoveKey "self run:#testRemoveKey " | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict keys size) = 2. dict removeKey: #a. self assert: dict keys size = 1. self should: [dict at: #a] raise: Error. self assert: (dict at: #b) = 2 ! Item was changed: + ----- Method: DictionaryTest>>testSelect (in category 'tests - collection protocol') ----- - ----- Method: DictionaryTest>>testSelect (in category 'testing') ----- testSelect "Ensure that Dictionary>>select: answers a dictionary not something else" | dict expected result | dict := Dictionary newFromPairs:{ #first. 1. #second. 2. #third. 3. #fourth. 4. #fifth. 5. }. result := dict select:[:each| each odd]. expected := Dictionary newFromPairs:{ #first. 1. #third. 3. #fifth. 5. }. self assert: result = expected. result at: #first put: 0. self assert: (dict at: #first) = 1 "No side effects"! Item was changed: + ----- Method: DictionaryTest>>testValues (in category 'tests - keys and value') ----- - ----- Method: DictionaryTest>>testValues (in category 'keys and value tests') ----- testValues "self run:#testValues " | a1 a2 a3 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := Dictionary new. dict add: a1. dict add: a2. self assert: (dict values size ) = 2. self assert: (dict values includes: 'Paris'). a3 := Association new. dict add: a3. self assert: (dict values size ) = 3. self assert: (dict values includes: nil). ! Item was changed: + ----- Method: DoubleByteArrayTest>>testAllPossibleValues (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testAllPossibleValues (in category 'testing') ----- testAllPossibleValues | doubleByteArray | doubleByteArray := (1 to: 65535) as: DoubleByteArray. 1 to: doubleByteArray size do: [:i | self assert: (doubleByteArray at: i) = i]! Item was changed: + ----- Method: DoubleByteArrayTest>>testAtOutOfBounds (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testAtOutOfBounds (in category 'testing') ----- testAtOutOfBounds "self debug: #testAtOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(DoubleByteArray with: 0) at: 2] raise: Error. self should: [(DoubleByteArray with: 0) at: -1] raise: Error]! Item was changed: + ----- Method: DoubleByteArrayTest>>testAtPutOutOfBounds (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testAtPutOutOfBounds (in category 'testing') ----- testAtPutOutOfBounds "self debug: #testAtPutOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(DoubleByteArray with: 0) at: 2 put: 1] raise: Error. self should: [(DoubleByteArray with: 0) at: -1 put: 1] raise: Error]! Item was changed: + ----- Method: DoubleByteArrayTest>>testByteSize (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testByteSize (in category 'testing') ----- testByteSize self assert: (DoubleByteArray new: 1) byteSize = 2 "2 bytes are 16 bits"! Item was changed: + ----- Method: DoubleByteArrayTest>>testCannotPutNegativeValue (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testCannotPutNegativeValue (in category 'testing') ----- testCannotPutNegativeValue self should: [DoubleByteArray with: -1] raise: Error! Item was changed: + ----- Method: DoubleByteArrayTest>>testCannotPutTooLargeValue (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testCannotPutTooLargeValue (in category 'testing') ----- testCannotPutTooLargeValue | maxValue | maxValue := 1 << 16 - 1. self assert: (DoubleByteArray with: maxValue) first = maxValue. self should: [DoubleByteArray with: maxValue + 1] raise: Error! Item was changed: + ----- Method: DoubleByteArrayTest>>testElementSize (in category 'tests') ----- - ----- Method: DoubleByteArrayTest>>testElementSize (in category 'testing') ----- testElementSize self assert: DoubleByteArray new bytesPerElement = 2 "2 bytes are 16 bits"! Item was changed: + ----- Method: DoubleWordArrayTest>>testAtOutOfBounds (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testAtOutOfBounds (in category 'testing') ----- testAtOutOfBounds "self debug: #testAtOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(DoubleWordArray with: 0) at: 2] raise: Error. self should: [(DoubleWordArray with: 0) at: -1] raise: Error]! Item was changed: + ----- Method: DoubleWordArrayTest>>testAtPutOutOfBounds (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testAtPutOutOfBounds (in category 'testing') ----- testAtPutOutOfBounds "self debug: #testAtPutOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(DoubleWordArray with: 0) at: 2 put: 1] raise: Error. self should: [(DoubleWordArray with: 0) at: -1 put: 1] raise: Error]! Item was changed: + ----- Method: DoubleWordArrayTest>>testByteSize (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testByteSize (in category 'testing') ----- testByteSize self assert: (DoubleWordArray new: 1) byteSize = 8 "8 bytes are 64 bits"! Item was changed: + ----- Method: DoubleWordArrayTest>>testCannotPutNegativeValue (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testCannotPutNegativeValue (in category 'testing') ----- testCannotPutNegativeValue self should: [DoubleWordArray with: -1] raise: Error! Item was changed: + ----- Method: DoubleWordArrayTest>>testCannotPutTooLargeValue (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testCannotPutTooLargeValue (in category 'testing') ----- testCannotPutTooLargeValue | maxValue | maxValue := 1 << 64 - 1. self assert: (DoubleWordArray with: maxValue) first = maxValue. self should: [DoubleWordArray with: maxValue + 1] raise: Error! Item was changed: + ----- Method: DoubleWordArrayTest>>testElementSize (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testElementSize (in category 'testing') ----- testElementSize self assert: DoubleWordArray new bytesPerElement = 8 "8 bytes are 64 bits"! Item was changed: + ----- Method: DoubleWordArrayTest>>testSomeValues (in category 'tests') ----- - ----- Method: DoubleWordArrayTest>>testSomeValues (in category 'testing') ----- testSomeValues | dwArray int next | next := [:x | x - 3 * x sqrtFloor + 5]. int := 0. dwArray := DoubleWordArray new: 1. [int highBit < 64] whileTrue: [dwArray at: 1 put: int. self assert: (dwArray at: 1) = int. int := next value: int]. self should: [dwArray at: 1 put: int] raise: Error! Item was changed: + ----- Method: FloatArrayTest>>testArithmeticCoercion (in category 'tests') ----- - ----- Method: FloatArrayTest>>testArithmeticCoercion (in category 'testing') ----- testArithmeticCoercion "This test is related to http://bugs.squeak.org/view.php?id=6782" self should: [3.0 / (FloatArray with: 2.0) = (FloatArray with: 1.5)]. self should: [3.0 * (FloatArray with: 2.0) = (FloatArray with: 6.0)]. self should: [3.0 + (FloatArray with: 2.0) = (FloatArray with: 5.0)]. self should: [3.0 - (FloatArray with: 2.0) = (FloatArray with: 1.0)].! Item was changed: + ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAt (in category 'tests') ----- - ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAt (in category 'testing') ----- testFloatArrayPluginPrimitiveAt "if FloatArrayPlugin primitive are not here, this test is dumb. Otherwise, it will compare primitive and #fromIEEE32Bit:" #( "regular numbers no truncation or rounding" 2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001 2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10 2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10 "smallest float32 before gradual underflow" 2r1.0e-126 "biggest float32" 2r1.11111111111111111111111e127 "overflow" 2r1.11111111111111111111111e128 "gradual underflow" 2r0.11111111111111111111111e-126 2r0.00000000000000000000001e-126 "with rounding mode : tests on 25 bits" 2r1.0000000000000000000000001 2r1.0000000000000000000000010 2r1.0000000000000000000000011 2r1.0000000000000000000000100 2r1.0000000000000000000000101 2r1.0000000000000000000000110 2r1.0000000000000000000000111 2r1.1111111111111111111111001 2r1.1111111111111111111111010 2r1.1111111111111111111111011 2r1.1111111111111111111111101 2r1.1111111111111111111111110 2r1.1111111111111111111111111 "overflow" 2r1.1111111111111111111111110e127 "gradual underflow" 2r0.1111111111111111111111111e-126 2r0.1111111111111111111111110e-126 2r0.1111111111111111111111101e-126 2r0.1111111111111111111111011e-126 2r0.1111111111111111111111010e-126 2r0.1111111111111111111111001e-126 2r0.0000000000000000000000111e-126 2r0.0000000000000000000000110e-126 2r0.0000000000000000000000101e-126 2r0.0000000000000000000000011e-126 2r0.0000000000000000000000010e-126 2r0.0000000000000000000000001e-126 2r0.0000000000000000000000010000000000000000000000000001e-126 ) do: [:e | self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)). self assert: ((FloatArray with: e negated) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e negated) basicAt: 1))]. "special cases" (Array with: Float infinity with: Float negativeInfinity with: Float negativeZero) do: [:e | self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1))]. "Cannot compare NaN" (Array with: Float nan) do: [:e | self assert: (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)) isNaN].! Item was changed: + ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAtPut (in category 'tests') ----- - ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAtPut (in category 'testing') ----- testFloatArrayPluginPrimitiveAtPut "if FloatArrayPlugin primitive are not here, this test is dumb. Otherwise, it will compare primitive and #asIEEE32BitWord" #( "regular numbers no truncation or rounding" 2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001 2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10 2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10 "smallest float32 before gradual underflow" 2r1.0e-126 "biggest float32" 2r1.11111111111111111111111e127 "overflow" 2r1.11111111111111111111111e128 "gradual underflow" 2r0.11111111111111111111111e-126 2r0.00000000000000000000001e-126 "with rounding mode : tests on 25 bits" 2r1.0000000000000000000000001 2r1.0000000000000000000000010 2r1.0000000000000000000000011 2r1.0000000000000000000000100 2r1.0000000000000000000000101 2r1.0000000000000000000000110 2r1.0000000000000000000000111 2r1.1111111111111111111111001 2r1.1111111111111111111111010 2r1.1111111111111111111111011 2r1.1111111111111111111111101 2r1.1111111111111111111111110 2r1.1111111111111111111111111 "overflow" 2r1.1111111111111111111111110e127 "gradual underflow" 2r0.1111111111111111111111111e-126 2r0.1111111111111111111111110e-126 2r0.1111111111111111111111101e-126 2r0.1111111111111111111111011e-126 2r0.1111111111111111111111010e-126 2r0.1111111111111111111111001e-126 2r0.0000000000000000000000111e-126 2r0.0000000000000000000000110e-126 2r0.0000000000000000000000101e-126 2r0.0000000000000000000000011e-126 2r0.0000000000000000000000010e-126 2r0.0000000000000000000000001e-126 2r0.0000000000000000000000010000000000000000000000000001e-126 ) do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord. self assert: ((FloatArray with: e negated) basicAt: 1) = e negated asIEEE32BitWord]. "special cases" (Array with: Float infinity with: Float negativeInfinity with: Float negativeZero with: Float nan) do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord]. ! Item was changed: + ----- Method: FloatArrayTest>>testVectorOperations (in category 'tests') ----- - ----- Method: FloatArrayTest>>testVectorOperations (in category 'testing') ----- testVectorOperations "Test primtive cases 'receiver size = argument size'." self assert: (FloatArray withAll: {2.0. 2.0}) equals: (FloatArray withAll: {4.0. 6.0}) / (FloatArray withAll: {2.0. 3.0}). self assert: (FloatArray withAll: {8.0. 9.0}) equals: (FloatArray withAll: {4.0. 4.5}) * (FloatArray withAll: {2.0. 2.0}). self assert: (FloatArray withAll: {6.0. 9.0}) equals: (FloatArray withAll: {4.0. 6.0}) + (FloatArray withAll: {2.0. 3.0}). self assert: (FloatArray withAll: {2.0. 3.0}) equals: (FloatArray withAll: {4.0. 6.0}) - (FloatArray withAll: {2.0. 3.0}). self assert: 26 equals: ((FloatArray withAll: {4.0. 6.0}) dot: (FloatArray withAll: {2.0. 3.0})). "Test corner cases where 'receiver size < argument size'." self should: [(FloatArray withAll: {4.0. 6.0}) / (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0}) * (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0}) + (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0}) - (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0}) dot: (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. "Test corner cases where 'receiver size > argument size'." self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) / (FloatArray withAll: {2.0. 3.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) * (FloatArray withAll: {2.0. 3.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) + (FloatArray withAll: {2.0. 3.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) - (FloatArray withAll: {2.0. 3.0})] raise: Error. self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) dot: (FloatArray withAll: {2.0. 3.0})] raise: Error. ! Item was changed: + ----- Method: GeneratorTest>>testAtEnd (in category 'tests') ----- - ----- Method: GeneratorTest>>testAtEnd (in category 'testing') ----- testAtEnd | generator | generator := self numbersBetween: 1 and: 3. self deny: generator atEnd. generator next. self deny: generator atEnd. generator next. self deny: generator atEnd. generator next. self assert: generator atEnd! Item was changed: + ----- Method: GeneratorTest>>testClose (in category 'tests') ----- - ----- Method: GeneratorTest>>testClose (in category 'testing') ----- testClose | generator doEnsure notEnsure | doEnsure := notEnsure := 0. [ generator := Generator on: [ :g | [ g yield: 1; yield: 2 ] ensure: [ doEnsure := doEnsure + 1 ] ]. self assert: doEnsure = 0; assert: notEnsure = 0. self assert: generator peek = 1. self assert: doEnsure = 0; assert: notEnsure = 0. generator close. self assert: doEnsure = 1; assert: notEnsure = 0 ] ensure: [ notEnsure := notEnsure + 1 ]. self assert: doEnsure = 1; assert: notEnsure = 1! Item was changed: + ----- Method: GeneratorTest>>testContents (in category 'tests') ----- - ----- Method: GeneratorTest>>testContents (in category 'testing') ----- testContents | generator | generator := self numbersBetween: 1 and: 3. self assert: generator contents = #(1 2 3)! Item was changed: + ----- Method: GeneratorTest>>testEmpty (in category 'tests') ----- - ----- Method: GeneratorTest>>testEmpty (in category 'testing') ----- testEmpty | generator | generator := Generator on: [ :g | ]. self assert: generator atEnd. self assert: generator peek isNil. self assert: generator next isNil! Item was changed: + ----- Method: GeneratorTest>>testEnsure (in category 'tests') ----- - ----- Method: GeneratorTest>>testEnsure (in category 'testing') ----- testEnsure | generator | generator := Generator on: [ :g | [ g yield: 1; yield: 2 ] ensure: [ g yield: 3 ] ]. self assert: generator upToEnd asArray = #( 1 2 3 )! Item was changed: + ----- Method: GeneratorTest>>testErrorPropagation (in category 'tests') ----- - ----- Method: GeneratorTest>>testErrorPropagation (in category 'testing') ----- testErrorPropagation "Ensure that errors in the generator block are properly propagated" | generator | generator := Generator on: [ :g | g yield: 1. g error: 'yo']. self should:[generator next] raise: Error. ! Item was changed: + ----- Method: GeneratorTest>>testFibonacci (in category 'tests') ----- - ----- Method: GeneratorTest>>testFibonacci (in category 'testing') ----- testFibonacci | generator | generator := self fibonacciSequence. self assert: (generator next: 10) asArray = #( 1 1 2 3 5 8 13 21 34 55 )! Item was changed: + ----- Method: GeneratorTest>>testNext (in category 'tests') ----- - ----- Method: GeneratorTest>>testNext (in category 'testing') ----- testNext | generator | generator := self numbersBetween: 1 and: 3. self assert: generator next = 1. self assert: generator next = 2. self assert: generator next = 3. self assert: generator next isNil! Item was changed: + ----- Method: GeneratorTest>>testPeek (in category 'tests') ----- - ----- Method: GeneratorTest>>testPeek (in category 'testing') ----- testPeek | generator | generator := self numbersBetween: 1 and: 3. self assert: generator peek = 1. self assert: generator peek = 1. generator next. self assert: generator peek = 2! Item was changed: + ----- Method: GeneratorTest>>testReset (in category 'tests') ----- - ----- Method: GeneratorTest>>testReset (in category 'testing') ----- testReset | generator | generator := self numbersBetween: 1 and: 3. self assert: generator next = 1. self assert: generator next = 2. generator reset. self assert: generator next = 1. self assert: generator next = 2. self assert: generator next = 3. self assert: generator next = nil. generator reset. self assert: generator next = 1! Item was changed: + ----- Method: GeneratorTest>>testResetUnwind (in category 'tests') ----- - ----- Method: GeneratorTest>>testResetUnwind (in category 'testing') ----- testResetUnwind "Just like close, just using reset" | generator doEnsure notEnsure | doEnsure := notEnsure := 0. [ generator := Generator on: [ :g | [ g yield: 1; yield: 2 ] ensure: [ doEnsure := doEnsure + 1 ] ]. self assert: doEnsure = 0; assert: notEnsure = 0. self assert: generator peek = 1. self assert: doEnsure = 0; assert: notEnsure = 0. generator reset. self assert: doEnsure = 1; assert: notEnsure = 0 ] ensure: [ notEnsure := notEnsure + 1 ]. self assert: doEnsure = 1; assert: notEnsure = 1! Item was changed: + ----- Method: GeneratorTest>>testSimple (in category 'tests') ----- - ----- Method: GeneratorTest>>testSimple (in category 'testing') ----- testSimple | generator | generator := Generator on: [ :g | g yield: 1; yield: 2 ]. self assert: generator upToEnd asArray = #( 1 2 )! Item was changed: + ----- Method: HashedCollectionTest>>testCapacity (in category 'tests - integrity') ----- - ----- Method: HashedCollectionTest>>testCapacity (in category 'test - integrity') ----- testCapacity | inconsistentCollections | inconsistentCollections := HashedCollection allSubInstances reject: [ :each | each class == MethodDictionary "MethodDictionary is the only HashedCollection which doesn't have prime array size" ifTrue: [ each capacity isPowerOfTwo ] ifFalse: [ each capacity isPrime ] ]. self assert: inconsistentCollections isEmpty! Item was changed: + ----- Method: HashedCollectionTest>>testGoodPrimeAtLeast (in category 'tests - class - sizing') ----- - ----- Method: HashedCollectionTest>>testGoodPrimeAtLeast (in category 'test - class - sizing') ----- testGoodPrimeAtLeast | primes | primes := HashedCollection goodPrimes. primes do: [ :each | self assert: (HashedCollection goodPrimeAtLeast: each) = each. self assert: (HashedCollection goodPrimeAtLeast: each - 1) = each. self assert: (HashedCollection goodPrimeAtLeast: each + 1) > each ]. (0 to: 1000) do: [ :each | | goodPrime | goodPrime := HashedCollection goodPrimeAtLeast: each. self assert: goodPrime isPrime. self assert: goodPrime >= each. self assert: (primes detect: [ :ea | ea >= each ] ifNone: [ each + 1 ]) = goodPrime ]. self assert: (HashedCollection goodPrimeAtLeast: primes last + 1) odd! Item was changed: + ----- Method: HashedCollectionTest>>testGoodPrimes (in category 'tests - class - sizing') ----- - ----- Method: HashedCollectionTest>>testGoodPrimes (in category 'test - class - sizing') ----- testGoodPrimes self testPrimes: HashedCollection goodPrimes! Item was changed: + ----- Method: HashedCollectionTest>>testPrimes: (in category 'tests - class - sizing') ----- - ----- Method: HashedCollectionTest>>testPrimes: (in category 'test - class - sizing') ----- testPrimes: primes | badPrimes | badPrimes := #(3 5 71 139 479 5861 277421). "These primes are less than the hashMultiply constant (1664525) and 1664525 \\ prime is close to 0 (mod prime). The following snippet reproduces these numbers: | hashMultiplyConstant | hashMultiplyConstant := 1 hashMultiply. (Integer primesUpTo: hashMultiplyConstant) select: [ :each | | remainder | remainder := hashMultiplyConstant \\ each. remainder <= 1 or: [ remainder + 1 = each ] ]." self assert: primes isSorted. primes do: [ :each | self assert: each isPrime. self deny: (each > 2069 and: [ badPrimes includes: each ]) ]. self assert: ( primes select: [ :p | | result | result := false. p > 2069 ifTrue: [ 1 to: 8 do: [ :k | 1 to: 32 do: [ :a | (p gcd: (256 raisedTo: k) + a) = 1 ifFalse: [ result := true ]. (p gcd: (256 raisedTo: k) - a) = 1 ifFalse: [ result := true ] ] ] ]. result ]) isEmpty.! Item was changed: + ----- Method: HashedCollectionTest>>testSizeFor (in category 'tests - class - sizing') ----- - ----- Method: HashedCollectionTest>>testSizeFor (in category 'test - class - sizing') ----- testSizeFor #( 0 1 5 10 30 57 89 578 1234 1912 2411 2591 5627 7849 10999 61356 68602 73189 79868 86789 239984 239985 501175 661865 841558 9669391 15207345 19827345 23469817 27858432 65223175 106650047 157687845 190892299 234947087 264782114 269617510 270995400 392236508 456647275 468699153 606865011 606997796 617927086 837938371 880614337 989233852 1000473294 1060034095) do: [ :each | | size | size := HashedCollection sizeFor: each. size <= HashedCollection goodPrimes last ifTrue: [ self assert: size isPrime ]. self assert: size odd. self assert: size * 3 // 4 >= each ]! Item was changed: + ----- Method: LinkedListTest>>test01add (in category 'tests') ----- - ----- Method: LinkedListTest>>test01add (in category 'testing') ----- test01add self assert: list isEmpty. list add: link1. self assert: list size = 1. self assert: list first = link1. list add: link2. self assert: list size = 2. self assert: list first = link1. self assert: list second = link2. list add: link3. self assert: list size = 3. self assert: list first = link1. self assert: list second = link2. self assert: list third = link3. list add: link4. self assert: list size = 4. self assert: list first = link1. self assert: list second = link2. self assert: list third = link3. self assert: list fourth = link4! Item was changed: + ----- Method: LinkedListTest>>test02addLast (in category 'tests') ----- - ----- Method: LinkedListTest>>test02addLast (in category 'testing') ----- test02addLast self assert: list isEmpty. list addLast: link1. self assert: list size = 1. self assert: list first = link1. list addLast: link2. self assert: list size = 2. self assert: list first = link1. self assert: list second = link2. list addLast: link3. self assert: list size = 3. self assert: list first = link1. self assert: list second = link2. self assert: list third = link3. list addLast: link4. self assert: list size = 4. self assert: list first = link1. self assert: list second = link2. self assert: list third = link3. self assert: list fourth = link4! Item was changed: + ----- Method: LinkedListTest>>test03addFirst (in category 'tests') ----- - ----- Method: LinkedListTest>>test03addFirst (in category 'testing') ----- test03addFirst self assert: list isEmpty. list addFirst: link1. self assert: list size = 1. self assert: list first = link1. list addFirst: link2. self assert: list size = 2. self assert: list first = link2. self assert: list second = link1. list addFirst: link3. self assert: list size = 3. self assert: list first = link3. self assert: list second = link2. self assert: list third = link1. list addFirst: link4. self assert: list size = 4. self assert: list first = link4. self assert: list second = link3. self assert: list third = link2. self assert: list fourth = link1! Item was changed: + ----- Method: LinkedListTest>>test04addBefore (in category 'tests') ----- - ----- Method: LinkedListTest>>test04addBefore (in category 'testing') ----- test04addBefore self assert: list isEmpty. list add: link1. self assert: list size = 1. self assert: list first == link1. list add: link2 before: link1. self assert: list size = 2. self assert: list first == link2. self assert: list second == link1. list add: link3 before: link1. self assert: list size = 3. self assert: list first == link2. self assert: list second == link3. self assert: list third == link1. list add: link4 before: link1. self assert: list size = 4. self assert: list first == link2. self assert: list second == link3. self assert: list third == link4. self assert: list fourth == link1! Item was changed: + ----- Method: LinkedListTest>>test05addBefore (in category 'tests') ----- - ----- Method: LinkedListTest>>test05addBefore (in category 'testing') ----- test05addBefore self assert: list isEmpty. list add: link1. self assert: list size = 1. self assert: list first == link1. list add: link2 before: link1. self assert: list size = 2. self assert: list first == link2. self assert: list second == link1. list add: link3 before: link2. self assert: list size = 3. self assert: list first == link3. self assert: list second == link2. self assert: list third == link1. list add: link4 before: link3. self assert: list size = 4. self assert: list first == link4. self assert: list second == link3. self assert: list third == link2. self assert: list fourth == link1! Item was changed: + ----- Method: LinkedListTest>>test06addAfter (in category 'tests') ----- - ----- Method: LinkedListTest>>test06addAfter (in category 'testing') ----- test06addAfter self assert: list isEmpty. list add: link1. self assert: list size = 1. self assert: list first == link1. list add: link2 after: link1. self assert: list size = 2. self assert: list first == link1. self assert: list second == link2. list add: link3 after: link2. self assert: list size = 3. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. list add: link4 after: link3. self assert: list size = 4. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. self assert: list fourth == link4! Item was changed: + ----- Method: LinkedListTest>>test07addAfter (in category 'tests') ----- - ----- Method: LinkedListTest>>test07addAfter (in category 'testing') ----- test07addAfter self assert: list isEmpty. list add: link1. self assert: list size = 1. self assert: list first == link1. list add: link2 after: link1. self assert: list size = 2. self assert: list first == link1. self assert: list second == link2. list add: link3 after: link1. self assert: list size = 3. self assert: list first == link1. self assert: list second == link3. self assert: list third == link2. list add: link4 after: link1. self assert: list size = 4. self assert: list first == link1. self assert: list second == link4. self assert: list third == link3. self assert: list fourth == link2! Item was changed: + ----- Method: LinkedListTest>>test08addAfter (in category 'tests') ----- - ----- Method: LinkedListTest>>test08addAfter (in category 'testing') ----- test08addAfter | l first | l := LinkedList new. first := self class new n: 1. l add: first. l add: (self class new n: 3). self assert: (l collect:[:e | e n]) asArray = #(1 3). l add: (self class new n: 2) after: first. self assert: (l collect:[:e | e n]) asArray = #(1 2 3).! Item was changed: + ----- Method: LinkedListTest>>test09addAfter (in category 'tests') ----- - ----- Method: LinkedListTest>>test09addAfter (in category 'testing') ----- test09addAfter | l last | l := LinkedList new. last := self class new n: 2. l add: (self class new n: 1). l add: last. self assert: (l collect:[:e | e n]) asArray = #(1 2). l add: (self class new n: 3) after: last. self assert: (l collect:[:e | e n]) asArray = #(1 2 3).! Item was changed: + ----- Method: LinkedListTest>>test0FixtureIterateTest (in category 'tests - fixture') ----- - ----- Method: LinkedListTest>>test0FixtureIterateTest (in category 'test - fixture') ----- test0FixtureIterateTest | res | self collectionWithoutNilElements. self assert: (self collectionWithoutNilElements occurrencesOf: nil) = 0. res := true. self collectionWithoutNilElements detect: [ :each | (self collectionWithoutNilElements occurrencesOf: each) > 1 ] ifNone: [ res := false ]. self assert: res = false! Item was changed: + ----- Method: LinkedListTest>>test10removeFirst (in category 'tests') ----- - ----- Method: LinkedListTest>>test10removeFirst (in category 'testing') ----- test10removeFirst list add: link1. list add: link2. list add: link3. list add: link4. self assert: list size = 4. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. self assert: list fourth == link4. list removeFirst. self assert: list size = 3. self assert: list first == link2. self assert: list second == link3. self assert: list third == link4. list removeFirst. self assert: list size = 2. self assert: list first == link3. self assert: list second == link4. list removeFirst. self assert: list size = 1. self assert: list first == link4. list removeFirst. self assert: list isEmpty! Item was changed: + ----- Method: LinkedListTest>>test11removeLast (in category 'tests') ----- - ----- Method: LinkedListTest>>test11removeLast (in category 'testing') ----- test11removeLast list add: link1. list add: link2. list add: link3. list add: link4. self assert: list size = 4. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. self assert: list fourth == link4. list removeLast. self assert: list size = 3. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. list removeLast. self assert: list size = 2. self assert: list first == link1. self assert: list second == link2. list removeLast. self assert: list size = 1. self assert: list first == link1. list removeFirst. self assert: list isEmpty! Item was changed: + ----- Method: LinkedListTest>>test12remove (in category 'tests') ----- - ----- Method: LinkedListTest>>test12remove (in category 'testing') ----- test12remove list add: link1. list add: link2. list add: link3. list add: link4. self assert: list size = 4. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. self assert: list fourth == link4. list remove: link3. self assert: list size = 3. self assert: list first == link1. self assert: list second == link2. self assert: list third == link4. list remove: link2. self assert: list size = 2. self assert: list first == link1. self assert: list second == link4. list remove: link1. self assert: list size = 1. self assert: list first == link4. list remove: link4. self assert: list isEmpty! Item was changed: + ----- Method: LinkedListTest>>test13remove (in category 'tests') ----- - ----- Method: LinkedListTest>>test13remove (in category 'testing') ----- test13remove list add: link1. list add: link2. list add: link3. list add: link4. self assert: list size = 4. self assert: list first == link1. self assert: list second == link2. self assert: list third == link3. self assert: list fourth == link4. list remove: link1. self assert: list size = 3. self assert: list first == link2. self assert: list second == link3. self assert: list third == link4. list remove: link4. self assert: list size = 2. self assert: list first == link2. self assert: list second == link3. list remove: link2. self assert: list size = 1. self assert: list first == link3. list remove: link3. self assert: list isEmpty! Item was changed: + ----- Method: LinkedListTest>>test14removeIfAbsent (in category 'tests') ----- - ----- Method: LinkedListTest>>test14removeIfAbsent (in category 'testing') ----- test14removeIfAbsent list add: link1. self assert: list size = 1. self assert: list first == link1. list remove: link1. self assert: list isEmpty. [list remove: link1] on: Error do: [^ self]. "The execution should not get here. If yes, something went wrong." self assert: false! Item was changed: + ----- Method: LinkedListTest>>test22addAll (in category 'tests') ----- - ----- Method: LinkedListTest>>test22addAll (in category 'testing') ----- test22addAll | link5 link6 link7 link8 listToBeAdded | link5 := Link new. link6 := Link new. link7 := Link new. link8 := Link new. list add: link1; add: link2; add: link3; add: link4. listToBeAdded := LinkedList new. listToBeAdded add: link5; add: link6; add: link7; add: link8. list addAll: listToBeAdded. self should: [(list at: 1) == link1]. self should: [(list at: 2) == link2]. self should: [(list at: 3) == link3]. self should: [(list at: 4) == link4]. self should: [(list at: 5) == link5]. self should: [(list at: 6) == link6]. self should: [(list at: 7) == link7]. self should: [(list at: 8) == link8].! Item was changed: + ----- Method: LinkedListTest>>testEqualSign (in category 'tests - equality') ----- - ----- Method: LinkedListTest>>testEqualSign (in category 'test - equality') ----- testEqualSign "self debug: #testEqualSign" self deny: (self empty = self nonEmpty).! Item was changed: + ----- Method: LinkedListTest>>testEqualSignIsTrueForNonIdenticalButEqualCollections (in category 'tests - equality') ----- - ----- Method: LinkedListTest>>testEqualSignIsTrueForNonIdenticalButEqualCollections (in category 'test - equality') ----- testEqualSignIsTrueForNonIdenticalButEqualCollections "self debug: #testEqualSignIsTrueForNonIdenticalButEqualCollections" self assert: (self empty = self empty copy). self assert: (self empty copy = self empty). self assert: (self empty copy = self empty copy). self assert: (self nonEmpty = self nonEmpty copy). self assert: (self nonEmpty copy = self nonEmpty). self assert: (self nonEmpty copy = self nonEmpty copy).! Item was changed: + ----- Method: LinkedListTest>>testEqualSignOfIdenticalCollectionObjects (in category 'tests - equality') ----- - ----- Method: LinkedListTest>>testEqualSignOfIdenticalCollectionObjects (in category 'test - equality') ----- testEqualSignOfIdenticalCollectionObjects "self debug: #testEqualSignOfIdenticalCollectionObjects" self assert: (self empty = self empty). self assert: (self nonEmpty = self nonEmpty). ! Item was changed: + ----- Method: LinkedListTest>>testRemoveAll (in category 'tests') ----- - ----- Method: LinkedListTest>>testRemoveAll (in category 'testing') ----- testRemoveAll | list2 | list add: link1. list add: link2. list add: link3. list add: link4. list2 := list copy. list removeAll. self assert: list size = 0. self assert: list2 size = 4 description: 'the copy has not been modified'! Item was changed: + ----- Method: MatrixTest>>setUp (in category 'running') ----- - ----- Method: MatrixTest>>setUp (in category 'testing') ----- setUp matrix1 := Matrix new: 2. matrix1 at:1 at:1 put: 1. matrix1 at:1 at:2 put: 3. matrix1 at:2 at:1 put: 2. matrix1 at:2 at:2 put: 4. matrix2 := Matrix new: 2. matrix2 at:1 at:1 put: 3. matrix2 at:1 at:2 put: 7. matrix2 at:2 at:1 put: 4. matrix2 at:2 at:2 put: 8.! Item was changed: + ----- Method: OrderedCollectionTest>>testAdd (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAdd (in category 'testsAdding') ----- testAdd | l | l := #(1 2 3 4) asOrderedCollection. l add: 88. self assert: (l = #(1 2 3 4 88) asOrderedCollection). l add: 99. self assert: (l = #(1 2 3 4 88 99) asOrderedCollection). ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAfter (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddAfter (in category 'testsAdding') ----- testAddAfter | l | l := #(1 2 3 4) asOrderedCollection. l add: 88 after: 1. self assert: (l = #(1 88 2 3 4) asOrderedCollection). l add: 99 after: 2. self assert: (l = #(1 88 2 99 3 4) asOrderedCollection). ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAfterIndex (in category 'tests - public methods') ----- - ----- Method: OrderedCollectionTest>>testAddAfterIndex (in category 'testing-public methods') ----- testAddAfterIndex "self run: #testAddAfterIndex" | l | l := #(1 2 3 4) asOrderedCollection. l add: 77 afterIndex: 0. self assert: (l = #(77 1 2 3 4) asOrderedCollection). l add: 88 afterIndex: 2. self assert: (l = #(77 1 88 2 3 4) asOrderedCollection). l add: 99 afterIndex: l size. self assert: (l = #(77 1 88 2 3 4 99) asOrderedCollection). self should:[l add: 666 afterIndex: -1] raise: Error. self should:[l add: 666 afterIndex: l size+1] raise: Error. "Now make room by removing first two and last two elements, and see if the illegal bounds test still fails" (l first: 2) , (l last: 2) reversed do: [:e | l remove: e]. self should: [l add: 666 afterIndex: -1] raise: Error. self should: [l add: 666 afterIndex: l size+1] raise: Error.! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAll (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddAll (in category 'testsAdding') ----- testAddAll "Allows one to add each element of an orderedCollection at the end of another orderedCollection " "self run:#testAddAll" | c1 c2 | c1 := #(1 2 3 4 ) asOrderedCollection. c2 := #(5 6 7 8 9 ) asOrderedCollection. c1 addAll: c2. self assert: c1 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAllFirst (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddAllFirst (in category 'testsAdding') ----- testAddAllFirst "Allows one to add each element of an orderedCollection at the beginning of another orderedCollection " "self run:#testAddAllFirst" | c1 c2 | c1 := #(1 2 3 4 ) asOrderedCollection. c2 := #(5 6 7 8 9 ) asOrderedCollection. c2 addAllFirst: c1. self assert: c2 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAllFirstUnlessAlreadyPresent (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddAllFirstUnlessAlreadyPresent (in category 'testsAdding') ----- testAddAllFirstUnlessAlreadyPresent "Allows one to add each element of an orderedCollection at the beginning of another orderedCollection preserving the order but no duplicate element" "self run:#testAddAllFirstUnlessAlreadyPresent" | c1 c2 c3 | c1 := #(1 2 3 4 ) asOrderedCollection. c2 := #(5 6 7 8 9 ) asOrderedCollection. c3 := #(0 1 ) asOrderedCollection. c2 addAllFirstUnlessAlreadyPresent: c1. self assert: c2 = #(1 2 3 4 5 6 7 8 9 ) asOrderedCollection. c1 addAllFirstUnlessAlreadyPresent: c3. self deny: c1 = #(0 1 1 2 3 4 ) asOrderedCollection. self assert: c1 = #(0 1 2 3 4 ) asOrderedCollection. ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddAllLast (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddAllLast (in category 'testsAdding') ----- testAddAllLast "Allows one to add each element of an orderedCollection at the beginning of another orderedCollection " "self run:#testAddAllLast" | c1 c2 | c1 := #(1 2 3 4 ) asOrderedCollection. c2 := #(5 6 7 8 9 ) asOrderedCollection. c1 addAllLast: c2. self assert: c1 = #(1 2 3 4 5 6 7 8 9) asOrderedCollection! Item was changed: + ----- Method: OrderedCollectionTest>>testAddBefore (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddBefore (in category 'testsAdding') ----- testAddBefore | l | l := #(1 2 3 4) asOrderedCollection. l add: 88 before: 1. self assert: (l = #(88 1 2 3 4) asOrderedCollection). l add: 99 before: 2. self assert: (l = #(88 1 99 2 3 4) asOrderedCollection). ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddBeforeAndRemove (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddBeforeAndRemove (in category 'testsAdding') ----- testAddBeforeAndRemove | l initialCollection | l := #(1 2 3 4) asOrderedCollection. initialCollection := l shallowCopy. l add: 88 before: 1. self assert: (l = #(88 1 2 3 4) asOrderedCollection). l add: 99 before: 2. self assert: (l = #(88 1 99 2 3 4) asOrderedCollection). l remove: 99. l remove: 88. self assert: l = initialCollection. ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddBeforeIndex (in category 'tests - public methods') ----- - ----- Method: OrderedCollectionTest>>testAddBeforeIndex (in category 'testing-public methods') ----- testAddBeforeIndex "self run: #testAddBeforeIndex" | l | l := #(1 2 3 4) asOrderedCollection. l add: 77 beforeIndex: 1. self assert: (l = #(77 1 2 3 4) asOrderedCollection). l add: 88 beforeIndex: 3. self assert: (l = #(77 1 88 2 3 4) asOrderedCollection). l add: 99 beforeIndex: l size+1. self assert: (l = #(77 1 88 2 3 4 99) asOrderedCollection). self should:[l add: 666 beforeIndex: 0] raise: Error. self should:[l add: 666 beforeIndex: l size+2] raise: Error. "Now make room by removing first two and last two elements, and see if the illegal bounds test still fails" (l first: 2) , (l last: 2) reversed do: [:e | l remove: e]. self should:[l add: 666 beforeIndex: 0] raise: Error. self should:[l add: 666 beforeIndex: l size+2] raise: Error. ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddDuplicateItem1 (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddDuplicateItem1 (in category 'testsAdding') ----- testAddDuplicateItem1 | collection | collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. collection add: 'John' before: 'John'. self assert: ((collection asBag occurrencesOf: 'John') = 2 and: [(collection at: (collection indexOf: 'John') + 1) = (collection at: (collection indexOf: 'John'))])! Item was changed: + ----- Method: OrderedCollectionTest>>testAddFirst (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddFirst (in category 'testsAdding') ----- testAddFirst | l | l := #(1 2 3 4) asOrderedCollection. l addFirst: 88. self assert: (l = #(88 1 2 3 4) asOrderedCollection). l addFirst: 99. self assert: (l = #(99 88 1 2 3 4) asOrderedCollection). ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddItem1 (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddItem1 (in category 'testsAdding') ----- testAddItem1 | collection size | collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. size := collection size. collection add: 'James' before: 'Jim'. collection add: 'Margaret' before: 'Andrew'. self assert: size + 2 = collection size. ! Item was changed: + ----- Method: OrderedCollectionTest>>testAddItem2 (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddItem2 (in category 'testsAdding') ----- testAddItem2 | collection | collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. collection add: 'James' before: 'Jim'. collection add: 'Margaret' before: 'Andrew'. self assert: (collection indexOf: 'James') + 1 = (collection indexOf: 'Jim'). self assert: (collection indexOf: 'Margaret') + 1 = (collection indexOf: 'Andrew')! Item was changed: + ----- Method: OrderedCollectionTest>>testAddLast (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAddLast (in category 'testsAdding') ----- testAddLast | l | l := #(1 2 3 4) asOrderedCollection. l addLast: 88. self assert: (l = #(1 2 3 4 88) asOrderedCollection). l addLast: 99. self assert: (l = #(1 2 3 4 88 99) asOrderedCollection). ! Item was changed: + ----- Method: OrderedCollectionTest>>testAt (in category 'tests - accessing') ----- - ----- Method: OrderedCollectionTest>>testAt (in category 'testsAccessing') ----- testAt | collection | collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. self assert: (collection at:1) = 'Jim'. self assert: (collection at:2) = 'Mary'! Item was changed: + ----- Method: OrderedCollectionTest>>testAtIfAbsentPut (in category 'tests - adding') ----- - ----- Method: OrderedCollectionTest>>testAtIfAbsentPut (in category 'testsAdding') ----- testAtIfAbsentPut "Allows one to add an element at an index if no element exist at this index" "self run:#testAtIfAbsentPut" | c | c := #(1 2 3 4 ) asOrderedCollection. c at: 2 ifAbsentPut: [5]. self assert: #(1 2 3 4 ) asOrderedCollection equals: c. c at: 5 ifAbsentPut: [5]. self assert: #(1 2 3 4 5 ) asOrderedCollection equals: c. c at: 7 ifAbsentPut: [7]. self assert: #(1 2 3 4 5 nil 7 ) asOrderedCollection equals: c.! Item was changed: + ----- Method: OrderedCollectionTest>>testAtPut (in category 'tests - accessing') ----- - ----- Method: OrderedCollectionTest>>testAtPut (in category 'testsAccessing') ----- testAtPut "Allows one to replace an element but not at an off range index" "self run:#testAtPut" | c | c := #(1 2 3 4 ) asOrderedCollection. c at: 2 put: 5. self assert: c = #(1 5 3 4 ) asOrderedCollection. self should: [c at: 5 put: 8] raise: Error. self deny: c = #(1 5 3 4 8 ) asOrderedCollection! Item was changed: + ----- Method: OrderedCollectionTest>>testCapacity (in category 'tests - accessing') ----- - ----- Method: OrderedCollectionTest>>testCapacity (in category 'testsAccessing') ----- testCapacity "Allows one to check the current capacity of an Ordered collection" "self run:#testCapacity" | c1 c2 c3 | c1 := #(1 2 ) asOrderedCollection. self assert: (c1 capacity = 2). c2 := OrderedCollection new: 10. c2 add: 3. self assert: (c2 capacity = 10). c3 := OrderedCollection new. self deny: (c3 capacity = 0). ! Item was changed: + ----- Method: OrderedCollectionTest>>testCollect (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testCollect (in category 'testsEnumerating') ----- testCollect "Allows one to collect some element of a collection into another collection" "self run: #testCollect" | c1 c2 res | c1 := #(-1 2 -3 4) asOrderedCollection. c2 := #(1 2 3 4) asOrderedCollection. res := c1 collect: [:each | each abs]. self assert: (c2 = res).! Item was changed: + ----- Method: OrderedCollectionTest>>testCollectFromTo (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testCollectFromTo (in category 'testsEnumerating') ----- testCollectFromTo "Allows one to collect some element of a collection into another collection between a first index and an end index for the collect" "self run: #testCollectFromTo" | c1 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. res := c1 collect: [:each | each abs] from: 1 to: 3. self assert: (res = #(1 2 3) asOrderedCollection). self should: [c1 collect: [:each | each abs] from: 10 to: 13] raise: Error. self should: [c1 collect: [:each | each abs] from: 5 to: 2] raise: Error.! Item was changed: + ----- Method: OrderedCollectionTest>>testCopyEmpty (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testCopyEmpty (in category 'testsCopying') ----- testCopyEmpty "Allows one to create a copy of the receiver that contains no elements" "self run:#testCopyEmpty" | c1 c2 | c1 := #(1 2 3 4 ) asOrderedCollection. c2 := c1 copyEmpty. self assert: (c2 size = 0).! Item was changed: + ----- Method: OrderedCollectionTest>>testCopyFromTo (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testCopyFromTo (in category 'testsCopying') ----- testCopyFromTo "Allows one to create a copy of the receiver that contains elements from position start to end" "self run: #testCopyFromTo" | c1 c2 c3 | c1 := #(1 2 3 4) asOrderedCollection. c2 := (c1 copyFrom: 1 to: 2). self assert: c2 = #(1 2) asOrderedCollection. self should: [c1 copyFrom: 10 to: 20] raise: Error. c3 := c1 copyFrom: 4 to: 2. self assert: c3 isEmpty. self should: [c1 copyFrom: 4 to: 5 ] raise: Error. ! Item was changed: + ----- Method: OrderedCollectionTest>>testCopyReplaceFromToWith (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testCopyReplaceFromToWith (in category 'testsCopying') ----- testCopyReplaceFromToWith "Allows one to create a copy from the receiver which elements between start and end of the receiver being replace by element of the collection after with:" "self run:#testCopyReplaceFromToWith" | c1 c2 c3 c4 | c1 := #(1 2 3 4) asOrderedCollection. c2 := #(5 6 7 8 9) asOrderedCollection. c3 := (c2 copyReplaceFrom: 1 to: 2 with: c1). self assert: c3 = #(1 2 3 4 7 8 9) asOrderedCollection. self should: [c2 copyReplaceFrom: 3 to: 1 with: c1] raise: Error. c4 := (c2 copyReplaceFrom: 10 to: 25 with: c1). self assert: c4 = #(5 6 7 8 9 1 2 3 4) asOrderedCollection. ! Item was changed: + ----- Method: OrderedCollectionTest>>testCopyWith (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testCopyWith (in category 'testsCopying') ----- testCopyWith "Allows one to create a copy of the receiver that contains the new element at the end" "self run: #testCopyWith" | c1 | c1 := #(1 2 3 4) asOrderedCollection. c1 := c1 copyWith: 6. self assert: c1 = #(1 2 3 4 6) asOrderedCollection. ! Item was changed: + ----- Method: OrderedCollectionTest>>testForceToPadding (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testForceToPadding (in category 'testsCopying') ----- testForceToPadding "This is a non regression bug for http://bugs.squeak.org/view.php?id=7296" | c1 c2 paddingElement | "source collection" c1 := #(5 3 7 2 ) asOrderedCollection. paddingElement := nil. "force length to longer" c2 := c1 forceTo: 10 paddingWith: paddingElement. self assert: (c1 ~~ c2) description: 'forceTo:paddingWith: should modify a copy'. self assert: (c2 size = 10). self assert: (c2 copyFrom: 1 to: c1 size) = c1. self assert: ((c1 size + 1 to: c2 size) allSatisfy: [:i | (c2 at: i) = paddingElement]). "force length to shorter" c2 := c1 forceTo: 3 paddingWith: paddingElement. self assert: (c1 ~~ c2) description: 'forceTo:paddingWith: should modify a copy'. self assert: (c2 size = 3). self assert: (c2 copyFrom: 1 to: 3) = (c1 copyFrom: 1 to: 3). "SAME TEST BUT PADDING AT START FOLLOWING..." "force length to longer" c2 := c1 forceTo: 10 paddingStartWith: paddingElement. self assert: (c1 ~~ c2) description: 'forceTo:paddingStartWith: should modify a copy'. self assert: (c2 size = 10). self assert: (c2 copyFrom: c2 size - c1 size + 1 to: c2 size) = c1. self assert: ((1 to: c2 size - c1 size) allSatisfy: [:i | (c2 at: i) = paddingElement]). "force length to shorter" c2 := c1 forceTo: 3 paddingStartWith: paddingElement. self assert: (c1 ~~ c2) description: 'forceTo:paddingStartWith: should modify a copy'. self assert: (c2 size = 3). self assert: (c2 copyFrom: 1 to: 3) = (c1 copyFrom: 1 to: 3).! Item was changed: + ----- Method: OrderedCollectionTest>>testIndexOf (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testIndexOf (in category 'testsEnumerating') ----- testIndexOf | collection indices | collection := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. indices := collection collect: [:item | collection indexOf: item]. self assert: (1 to: 4) asOrderedCollection = indices! Item was changed: + ----- Method: OrderedCollectionTest>>testIndexOfWithDuplicates (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testIndexOfWithDuplicates (in category 'testsEnumerating') ----- testIndexOfWithDuplicates | collection indices bagOfIndices | collection := #('Jim' 'Mary' 'John' 'Andrew' 'Mary' 'John' 'Jim' 'Micheal') asOrderedCollection. indices := collection collect: [:item | collection indexOf: item]. self assert: indices asSet size = collection asSet size. bagOfIndices := indices asBag. self assert: (indices asSet allSatisfy: [:index | (bagOfIndices occurrencesOf: index) = (collection occurrencesOf: (collection at: index))]). " indexOf: returns the index of the first occurrence of an item. For an item with n occurrences, the index of its first occurrence is found n times. "! Item was changed: + ----- Method: OrderedCollectionTest>>testOverlappingPairsCollect (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testOverlappingPairsCollect (in category 'testsEnumerating') ----- testOverlappingPairsCollect | o | o := #(5 4 3 2 1) asOrderedCollection. self assert: #(9 7 5 3) asOrderedCollection equals: (o overlappingPairsCollect: [ :a :b | a + b ])! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveAll (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveAll (in category 'testsRemoving') ----- testRemoveAll "Allows one to remove all elements of a collection" | c1 c2 s2 | c1 := #(2 3 4 6) asOrderedCollection. c1 addAll: (1 to: 200). c2 := c1 copy. s2 := c2 size. c1 removeAll. self assert: c1 size = 0. self assert: c2 size = s2 description: 'the copy has not been modified' ! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveAllSuchThat (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveAllSuchThat (in category 'testsRemoving') ----- testRemoveAllSuchThat | collection | collection := (1 to: 10) asOrderedCollection. collection removeAllSuchThat: [:e | e even]. self assert: collection = (1 to: 10 by: 2) asOrderedCollection! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveAt (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveAt (in category 'testsRemoving') ----- testRemoveAt "Allows one to remove an element from a collection at an index" "self run:#testRemoveAt" | c1 | c1 := #(2 3 4 6) asOrderedCollection. c1 removeAt: 2. self assert: (c1 = #(2 4 6) asOrderedCollection). self should: [c1 removeAt: 10] raise: Error. self should: [c1 removeAt: -1] raise: Error. ! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveFirst (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveFirst (in category 'testsRemoving') ----- testRemoveFirst "Allows one to remove n element of a collection at the first" "self run:#testRemoveFirst" | c1 | c1 := #(2 3 4 6) asOrderedCollection. c1 removeFirst: 1. self assert: (c1 = #(3 4 6) asOrderedCollection). c1 removeFirst: 2. self assert: (c1 = #(6) asOrderedCollection). self should: [c1 removeFirst: 10] raise: Error. ! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveIfAbsent (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveIfAbsent (in category 'testsRemoving') ----- testRemoveIfAbsent "Allows one to remove an element from a collection and to copy it in another collection." "If the element isn't in the first collection, the second collection copy the element after ifAbsent" "self run:#testRemoveIfAbsent" | c1 c2 | c1 := #(1 2 3 4) asOrderedCollection. c2 := OrderedCollection new. c2 add: (c1 remove: 2 ifAbsent: [6]). self assert: (c1 = #(1 3 4) asOrderedCollection). self assert: (c2 = #(2) asOrderedCollection). c2 add: (c1 remove: 18 ifAbsent: [6]). self assert: (c1 = #(1 3 4) asOrderedCollection). self assert: (c2 = #(2 6) asOrderedCollection).! Item was changed: + ----- Method: OrderedCollectionTest>>testRemoveLast (in category 'tests - removing') ----- - ----- Method: OrderedCollectionTest>>testRemoveLast (in category 'testsRemoving') ----- testRemoveLast "Allows one to remove n element of a collection at the end" "self run:#testRemoveLast" | c1 | c1 := #(2 3 4 6) asOrderedCollection. c1 removeLast: 1. self assert: (c1 = #(2 3 4) asOrderedCollection). c1 removeLast: 2. self assert: (c1 = #(2) asOrderedCollection). self should: [c1 removeLast: 10] raise: Error.! Item was changed: + ----- Method: OrderedCollectionTest>>testReversed (in category 'tests - copying') ----- - ----- Method: OrderedCollectionTest>>testReversed (in category 'testsCopying') ----- testReversed | collection1 collection2 | collection1 := #('Jim' 'Mary' 'John' 'Andrew' ) asOrderedCollection. collection2 := collection1 reversed. self assert: collection2 first = 'Andrew'. self assert: collection2 last = 'Jim'! Item was changed: + ----- Method: OrderedCollectionTest>>testSize (in category 'tests - accessing') ----- - ----- Method: OrderedCollectionTest>>testSize (in category 'testsAccessing') ----- testSize "Allows one to check the size of an Ordered collection" "self run:#testSize" | c1 c2 | c1 := #(1 2 ) asOrderedCollection. self assert: (c1 size = 2). c2 := OrderedCollection new. self assert: (c2 size = 0) ! Item was changed: + ----- Method: OrderedCollectionTest>>testStreamContents (in category 'tests - streaming') ----- - ----- Method: OrderedCollectionTest>>testStreamContents (in category 'testStreaming') ----- testStreamContents | oc | self shouldnt: [oc := OrderedCollection streamContents: [:stream | 1 to: 3 do: [:i | stream nextPut: i]]] raise: Error description: 'it should be possible to stream over an OrderedCollection'. self assert: oc class = OrderedCollection. self assert: oc = (1 to: 3) asOrderedCollection.! Item was changed: + ----- Method: OrderedCollectionTest>>testWithCollect (in category 'tests - enumerating') ----- - ----- Method: OrderedCollectionTest>>testWithCollect (in category 'testsEnumerating') ----- testWithCollect "Allows one to collect some element of two collections into another collection with element corresponding to the condition in the blocks" "self run: #testWithCollect" | c1 c2 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. c2 := #(-9 10 -11 12 -13 14 -15 16) asOrderedCollection. res := c1 with: c2 collect: [:each1 :each2 | each1 < each2 ifTrue: [each1] ifFalse: [each2]]. self assert: (res = #(-9 2 -11 4 -13 6 -15 8) asOrderedCollection). ! Item was changed: + ----- Method: QFormatMimeConverterTest>>testDecode (in category 'tests') ----- - ----- Method: QFormatMimeConverterTest>>testDecode (in category 'running') ----- testDecode | encodedString decodedString | encodedString := '=E0'. decodedString := QEncodingMimeConverter mimeDecode: encodedString as: WideString. self assert: 'à' equals: decodedString. encodedString := 'H=FC_Th=F6r=E4!!'. decodedString := QEncodingMimeConverter mimeDecode: encodedString as: WideString. self assert: 'Hü Thörä!!' equals: decodedString. encodedString := 'H=FC=20Th=F6r=E4!!'. decodedString := QEncodingMimeConverter mimeDecode: encodedString as: WideString. self assert: 'Hü Thörä!!' equals: decodedString.! Item was changed: + ----- Method: QFormatMimeConverterTest>>testEncodeSimpleString (in category 'tests') ----- - ----- Method: QFormatMimeConverterTest>>testEncodeSimpleString (in category 'running') ----- testEncodeSimpleString | encodedString | encodedString := QEncodingMimeConverter mimeEncode: message. self assert: '=?UTF-8?Q?H=C3=BC?= =?UTF-8?Q?Th=C3=B6r=C3=A4!!?=' equals: encodedString. ! Item was changed: + ----- Method: QFormatMimeConverterTest>>testEncodeSimpleStringWithQuestionMark (in category 'tests') ----- - ----- Method: QFormatMimeConverterTest>>testEncodeSimpleStringWithQuestionMark (in category 'running') ----- testEncodeSimpleStringWithQuestionMark | encodedString | encodedString := QEncodingMimeConverter mimeEncode: 'Is üt?'. self assert: 'Is =?UTF-8?Q?=C3=BCt=3F?=' equals: encodedString. ! Item was changed: + ----- Method: QFormatMimeConverterTest>>testRoundtrip (in category 'tests') ----- - ----- Method: QFormatMimeConverterTest>>testRoundtrip (in category 'running') ----- testRoundtrip | result start | start := 'Is üt?'. result := ((QEncodingMimeConverter mimeEncode: start) as: String) decodeMimeHeader. self assert: start equals: result. ! Item was changed: + ----- Method: RWBinaryOrTextStreamTest>>expectedFailures (in category 'failures') ----- - ----- Method: RWBinaryOrTextStreamTest>>expectedFailures (in category 'testing') ----- expectedFailures ^#( testExisting "This is more like a request for new behavior than a bug." )! Item was changed: + ----- Method: SetTest>>testAdd (in category 'tests - original tests') ----- - ----- Method: SetTest>>testAdd (in category 'Sunit original tests') ----- testAdd empty add: 5. self assert: (empty includes: 5).! Item was changed: + ----- Method: SetTest>>testGrow (in category 'tests - original tests') ----- - ----- Method: SetTest>>testGrow (in category 'Sunit original tests') ----- testGrow empty addAll: (1 to: 100). self assert: (empty size = 100). ! Item was changed: + ----- Method: SetTest>>testIfAbsentAdd (in category 'tests - original tests') ----- - ----- Method: SetTest>>testIfAbsentAdd (in category 'Sunit original tests') ----- testIfAbsentAdd | it | it := 5. self deny: (empty includes: it). self assert: (empty ifAbsentAdd: it). self assert: (empty includes: it). self deny: (empty ifAbsentAdd: it). self assert: (empty includes: it)! Item was changed: + ----- Method: SetTest>>testIllegal (in category 'tests - original tests') ----- - ----- Method: SetTest>>testIllegal (in category 'Sunit original tests') ----- testIllegal self should: [empty at: 5] raise: TestResult error. self should: [empty at: 5 put: #abc] raise: TestResult error. ! Item was changed: + ----- Method: SetTest>>testIncludes (in category 'tests - original tests') ----- - ----- Method: SetTest>>testIncludes (in category 'Sunit original tests') ----- testIncludes self assert: (full includes: 5). self assert: (full includes: #abc). self deny: (full includes: 3). ! Item was changed: + ----- Method: SetTest>>testOccurrences (in category 'tests - original tests') ----- - ----- Method: SetTest>>testOccurrences (in category 'Sunit original tests') ----- testOccurrences self assert: ((empty occurrencesOf: 0) = 0). self assert: ((full occurrencesOf: 5) = 1). full add: 5. self assert: ((full occurrencesOf: 5) = 1).! Item was changed: + ----- Method: SetTest>>testRemove (in category 'tests - original tests') ----- - ----- Method: SetTest>>testRemove (in category 'Sunit original tests') ----- testRemove full remove: 5. self assert: (full includes: #abc). self deny: (full includes: 5).! Item was changed: + ----- Method: SharedQueue2Test>>testBasics (in category 'tests') ----- - ----- Method: SharedQueue2Test>>testBasics (in category 'testing') ----- testBasics | q | q := SharedQueue2 new. self should: [ q nextOrNil = nil ]. q nextPut: 5. self should: [ q nextOrNil = 5 ]. self should: [ q nextOrNil = nil ]. ! Item was changed: + ----- Method: SharedQueue2Test>>testContention1 (in category 'tests') ----- - ----- Method: SharedQueue2Test>>testContention1 (in category 'testing') ----- testContention1 "here is a test case that breaks the standard SharedQueue from Squeak 3.8" | q r1 r2 | q := SharedQueue2 new. q nextPut: 5. q nextPut: 10. self should: [ q nextOrNil = 5 ]. [ r1 := q next ] fork. [ r2 := q next ] fork. Processor yield. "let the above two threads block" q nextPut: 10. Processor yield. self should: [ r1 = 10 ]. self should: [ r2 = 10 ]. self should: [ q nextOrNil = nil ]. ! Item was changed: + ----- Method: SharedQueue2Test>>testNextOrNilSuchThat (in category 'tests') ----- - ----- Method: SharedQueue2Test>>testNextOrNilSuchThat (in category 'testing') ----- testNextOrNilSuchThat | q item | q := SharedQueue2 new. q nextPut: 5. q nextPut: 6. item := q nextOrNilSuchThat: [ :x | x even ]. self should: [ item = 6 ]. self should: [ q nextOrNil = 5 ]. self should: [ q nextOrNil = nil ]. ! Item was changed: + ----- Method: StackTest>>testEmptyError (in category 'tests') ----- - ----- Method: StackTest>>testEmptyError (in category 'test') ----- testEmptyError | aStack | aStack := Stack new. self should: [ aStack top ] raise: Error. self should: [ aStack pop] raise: Error. aStack push: 'element'. self assert: 'element' equals: aStack top. self assert: 'element' equals: aStack pop. "The stack is empty again due to previous pop" self should: [ aStack top ] raise: Error. self should: [ aStack pop] raise: Error.! Item was changed: + ----- Method: StackTest>>testPop (in category 'tests') ----- - ----- Method: StackTest>>testPop (in category 'test') ----- testPop | aStack res elem | elem := 'anElement'. aStack := Stack new. self assert: aStack isEmpty. aStack push: 'a'. aStack push: elem. res := aStack pop. self assert: res = elem. self assert: res == elem. self assert: aStack size = 1. aStack pop. self assert: aStack isEmpty. ! Item was changed: + ----- Method: StackTest>>testPush (in category 'tests') ----- - ----- Method: StackTest>>testPush (in category 'test') ----- testPush | aStack | aStack := Stack new. aStack push: 'a'. self assert: aStack size = 1. aStack push: 'b'. self assert: aStack size = 2. ! Item was changed: + ----- Method: StackTest>>testSize (in category 'tests') ----- - ----- Method: StackTest>>testSize (in category 'test') ----- testSize | aStack | aStack := Stack new. self assert: aStack size = 0. aStack push: 'a'. self assert: aStack size = 1. aStack push: 'b'. self assert: aStack size = 2. aStack pop. self assert: aStack size = 1. aStack pop. self assert: aStack size = 0. ! Item was changed: + ----- Method: StackTest>>testTop (in category 'tests') ----- - ----- Method: StackTest>>testTop (in category 'test') ----- testTop | aStack | aStack := Stack new. self assert: aStack isEmpty. aStack push: 'a'. aStack push: 'b'. self assert: aStack top = 'b'. self assert: aStack top = 'b'. self assert: aStack size = 2.! Item was changed: + ----- Method: StringTest>>setUp (in category 'running') ----- - ----- Method: StringTest>>setUp (in category 'initialize-release') ----- setUp string := 'Hi, I am a String'! Item was changed: + ----- Method: TextAlignmentTest>>setUp (in category 'running') ----- - ----- Method: TextAlignmentTest>>setUp (in category 'initialize-release') ----- setUp super setUp. prototypes add: TextAlignment centered; add: TextAlignment justified; add: TextAlignment leftFlush; add: TextAlignment rightFlush ! Item was changed: + ----- Method: TextAttributesScanningTest>>expectedFailures (in category 'failures') ----- - ----- Method: TextAttributesScanningTest>>expectedFailures (in category 'running') ----- expectedFailures "Tests for text attributes that are apparently unused, and that may be candidates for removal from the image" ^#( testTextAnchor testTextIndent testTextMessageLink testTextPlusJumpStart testTextPlusJumpEnd "Actually failing tests which document bugs to be fixed (pre)" testTextFontReferenceForBoldFont testTextFontReferenceTTCForBoldFont )! Item was changed: + ----- Method: TextEmphasisTest>>setUp (in category 'running') ----- - ----- Method: TextEmphasisTest>>setUp (in category 'initialize-release') ----- setUp super setUp. prototypes add: TextEmphasis bold; add: TextEmphasis italic; add: TextEmphasis narrow; add: TextEmphasis normal; add: TextEmphasis struckOut; add: TextEmphasis underlined ! Item was changed: + ----- Method: TextFontChangeTest>>setUp (in category 'running') ----- - ----- Method: TextFontChangeTest>>setUp (in category 'initialize-release') ----- setUp "create the prototypes for testing" super setUp. prototypes add: TextFontChange defaultFontChange. prototypes add: TextFontChange font1. prototypes add: TextFontChange font2. prototypes add: TextFontChange font3. prototypes add: TextFontChange font4. prototypes add: (TextFontChange fontNumber: 6) ! Item was changed: + ----- Method: WeakSetTest>>testAddIncludesSizeReclaim (in category 'tests') ----- - ----- Method: WeakSetTest>>testAddIncludesSizeReclaim (in category 'testing') ----- testAddIncludesSizeReclaim | ws o2 o3 | o2 := 1/2. o3 := '123' copy. ws := WeakSet new. ws add: o2. ws add: o3. self assert: ws size = 2. self assert: (ws includes: o2). self assert: (ws includes: o3). "inclusion test does use equality, not identity" self assert: (ws includes: o3 copy) description: 'WeakSet are not WeakIdentitySet'. "only one copy is added" ws add: o3 copy. self assert: ws size = 2. "reclame objects so that slots of ws are nilled out" o2 := o3 := nil. Smalltalk garbageCollect. self deny: (ws includes: 1/2). self deny: (ws includes: '123' copy). "fast #size is not updated automatically by dead object reclamation But there is a slowSize trying to tell the truth" self assert: ws slowSize = 0.! Item was changed: + ----- Method: WeakSetTest>>testCollisions (in category 'tests') ----- - ----- Method: WeakSetTest>>testCollisions (in category 'testing') ----- testCollisions | ws o1 o2 o5 on remember forget | "create a weak set" ws := WeakSet new: 15. "select some fractions wanting same place in ws array" o1 := (2 to: 200) select: [:i | (ws scanFor: 1 / i) = 1]. o2 := (2 to: 200) select: [:i | (ws scanFor: 1 / i) = 2]. o5 := (2 to: 200) select: [:i | (ws scanFor: 1 / i) = 5]. on := (2 to: 200) select: [:i | (ws scanFor: 1 / i) = (ws array size - 1)]. "Add some fractions to the weak set, and remember a pointer for a few of them" remember := OrderedCollection new. forget := OrderedCollection new. ws add: (remember add: 1 / o1 first). ws add: (forget add: 1 / on second). ws add: (forget add: 1 / o1 second). ws add: (forget add: 1 / o5 second). ws add: (forget add: 1 / o2 second). ws add: (forget add: 1 / o1 third). ws add: (remember add: 1 / o2 first). ws add: (forget add: 1 / o5 third). ws add: (forget add: 1 / on third). ws add: (remember add: 1 / o2 fourth). ws add: (remember add: 1 / on first). ws add: (remember add: 1 / o5 first). "forget and reclaim all entries but those in remember" forget := nil. Smalltalk garbageCollect. remember do: [:m | self assert: (ws includes: m)]. ws add: 1/on second. remember do: [:m | self assert: (ws includes: m)]. ws add: (remember add: 1 / o1 fourth). ws add: (remember add: 1 / on fourth). remember remove: (ws remove: (1 / o5 first)). remember remove: (ws remove: (1 / on first)). remember remove: (ws remove: (1 / o2 first)). remember remove: (ws remove: (1 / o1 first)). remember do: [:m | self assert: (ws includes: m)]. ws add: 1/on second. ws add: 1/o5 second. remember do: [:m | self assert: (ws includes: m)]. ! Item was changed: + ----- Method: WeakSetTest>>testDoDontIterateOnReclaimedObjects (in category 'tests') ----- - ----- Method: WeakSetTest>>testDoDontIterateOnReclaimedObjects (in category 'testing') ----- testDoDontIterateOnReclaimedObjects | ws o1 o2 size | ws := WeakSet new. 2 to: 20 do: [:i | ws add: 1 / i]. o1 := 3.0. o2 := 4.0. ws add: o1; add: o2. "Reclaim memory" Smalltalk garbageCollect. size := 0. ws do: [:each | size := size + 1. self deny: each isNil]. self assert: size = 2! Item was changed: + ----- Method: WeakSetTest>>testGrowWhenNecessary (in category 'tests') ----- - ----- Method: WeakSetTest>>testGrowWhenNecessary (in category 'testing') ----- testGrowWhenNecessary | ws objs initialSize | objs := (2 to: 20) collect: [:i | 1 / i]. ws := WeakSet new: 5. initialSize := ws array size. 1 to: objs size do: [:k | ws add: (objs at: k)]. self assert: ws array size > initialSize description: 'The WeakSet grown because not enough room were preallocated'.! Item was changed: + ----- Method: WeakSetTest>>testIncludesNil (in category 'tests') ----- - ----- Method: WeakSetTest>>testIncludesNil (in category 'testing') ----- testIncludesNil | ws | ws := WeakSet new. self deny: (ws includes: nil). "After reclamation, should not includes nil: nil counts for nothing" ws add: 1/2. ws add: 1/3. Smalltalk garbageCollect. self deny: (ws includes: nil).! Item was changed: + ----- Method: WideCharacterSetTest>>testAddingToCharacterSet (in category 'tests') ----- - ----- Method: WideCharacterSetTest>>testAddingToCharacterSet (in category 'testing') ----- testAddingToCharacterSet | cs wcs wc | cs := CharacterSet newFrom: 'aeiouy'. wcs := cs copy. wc := 4452 asCharacter. self shouldnt: [wcs add: wc] raise: Error description: 'adding a WideCharacter to an ordinary CharacterSet should turn it into a WideCharacterSet'. self assert: (wcs size = (cs size + 1)) description: 'We just added a Character, size should be increased by one'. self deny: (wcs = cs) description: 'We just added a Character, sets should not be equal'. self deny: (cs = wcs) description: 'We just added a Character, sets should not be equal'. self assert: (cs allSatisfy: [:char | wcs includes: char]) description: 'Each character of the original CharacterSet should be included in the WideCharacterSet'. self assert: (wcs hasWideCharacters) description: 'We just added a WideCharacter, so this WideCharacterSet definitely has one'. self assert: (wcs includes: wc) description: 'We just added this WideCharacter, so this WideCharacterSet should include it'. wcs add: wc. self assert: (wcs size = (cs size + 1)) description: 'We just added a Character already included in the set, size should be unchanged'. wcs remove: wc. self assert: (wcs size = cs size) description: 'We added then removed a Character, now size should be equal to original'. self deny: (wcs hasWideCharacters) description: 'We just removed the only WideCharacter, so this WideCharacterSet definitely has no WideCharacter'. self assert: (wcs = cs) description: 'A WideCharacterSet can be equal to an Ordinary CharacterSet'. self assert: (cs = wcs) description: 'An ordinary CharacterSet can be equal to a WideCharacterSet'. self assert: (cs hash = wcs hash) description: 'If some objects are equal, then they should have same hash code'. ! Item was changed: + ----- Method: WideCharacterSetTest>>testCreation (in category 'tests') ----- - ----- Method: WideCharacterSetTest>>testCreation (in category 'testing') ----- testCreation "By now, only creation method is newFrom:" | cs1 wcs1 cs2 wcs2 byteString wideString | byteString := 'aeiouy'. wideString := 'aeiouy' copyWith: 340 asCharacter. cs1 := CharacterSet newFrom: byteString. wcs1 := WideCharacterSet newFrom: byteString. self assert: (wcs1 = cs1). self assert: (wcs1 size = byteString "asSet" size). cs2 := CharacterSet newFrom: wideString. wcs2 := WideCharacterSet newFrom: wideString. self assert: (wcs2 = cs2). self assert: (wcs2 size = wideString "asSet" size). self assert: ((byteString indexOfAnyOf: wcs1) = 1) description: 'This should used optimized byteArrayMap method'. self assert: ((byteString indexOfAnyOf: wcs2) = 1) description: 'This should used optimized byteArrayMap method'. self assert: (('bcd' indexOfAnyOf: wcs1) = 0) description: 'This should used optimized byteArrayMap method'. self assert: (('bcd' indexOfAnyOf: wcs2) = 0) description: 'This should used optimized byteArrayMap method'.! Item was changed: + ----- Method: WordArrayTest>>testAtOutOfBounds (in category 'tests') ----- - ----- Method: WordArrayTest>>testAtOutOfBounds (in category 'testing') ----- testAtOutOfBounds "self debug: #testAtOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(WordArray with: 0) at: 2] raise: Error. self should: [(WordArray with: 0) at: -1] raise: Error]! Item was changed: + ----- Method: WordArrayTest>>testAtPutOutOfBounds (in category 'tests') ----- - ----- Method: WordArrayTest>>testAtPutOutOfBounds (in category 'testing') ----- testAtPutOutOfBounds "self debug: #testAtPutOutOfBounds" "Do the test more than once to make sure the jitted code is tested." 1 to: 5 do: [:iteration| self should: [(WordArray with: 0) at: 2 put: 1] raise: Error. self should: [(WordArray with: 0) at: -1 put: 1] raise: Error]! Item was changed: + ----- Method: WordArrayTest>>testByteSize (in category 'tests') ----- - ----- Method: WordArrayTest>>testByteSize (in category 'testing') ----- testByteSize self assert: (WordArray new: 1) byteSize = 4 "4 bytes are 32 bits"! Item was changed: + ----- Method: WordArrayTest>>testCannotPutNegativeValue (in category 'tests') ----- - ----- Method: WordArrayTest>>testCannotPutNegativeValue (in category 'testing') ----- testCannotPutNegativeValue self should: [WordArray with: -1] raise: Error! Item was changed: + ----- Method: WordArrayTest>>testCannotPutTooLargeValue (in category 'tests') ----- - ----- Method: WordArrayTest>>testCannotPutTooLargeValue (in category 'testing') ----- testCannotPutTooLargeValue | maxValue | maxValue := 1 << 32 - 1. self assert: (WordArray with: maxValue) first = maxValue. self should: [WordArray with: maxValue + 1] raise: Error! Item was changed: + ----- Method: WordArrayTest>>testElementSize (in category 'tests') ----- - ----- Method: WordArrayTest>>testElementSize (in category 'testing') ----- testElementSize self assert: WordArray new bytesPerElement = 4 "4 bytes are 32 bits"! Item was changed: + ----- Method: WordArrayTest>>testSomeValues (in category 'tests') ----- - ----- Method: WordArrayTest>>testSomeValues (in category 'testing') ----- testSomeValues | wArray int next | next := [:x | x - 3 * x sqrtFloor + 5]. int := 0. wArray := WordArray new: 1. [int highBit < 32] whileTrue: [wArray at: 1 put: int. self assert: (wArray at: 1) = int. int := next value: int]. self should: [wArray at: 1 put: int] raise: Error!

3 4

The Trunk: KernelTests-pre.360.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-pre.360.mcz ==================== Summary ==================== Name: KernelTests-pre.360 Author: pre Time: 30 April 2019, 7:43:10.229008 pm UUID: 539584fb-f990-6449-bbb4-f09596a4501b Ancestors: KernelTests-pre.359 Recategorizes test methods in KernelTests =============== Diff against KernelTests-pre.359 =============== Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testBehaviorClassClassDescriptionMetaclassHierarchy (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testBehaviorClassClassDescriptionMetaclassHierarchy (in category 'testing') ----- testBehaviorClassClassDescriptionMetaclassHierarchy "self run: #testBehaviorClassClassDescriptionMetaclassHierarchy" self assert: Class superclass == ClassDescription. self assert: Metaclass superclass == ClassDescription. self assert: ClassDescription superclass == Behavior. self assert: Behavior superclass = Object. self assert: Class class class == Metaclass. self assert: Metaclass class class == Metaclass. self assert: ClassDescription class class == Metaclass. self assert: Behavior class class == Metaclass. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testClassDescriptionAllSubInstances (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testClassDescriptionAllSubInstances (in category 'testing') ----- testClassDescriptionAllSubInstances "self run: #testClassDescriptionAllSubInstances" | cdNo clsNo metaclsNo | cdNo := ClassDescription allSubInstances size. clsNo := Class allSubInstances size . metaclsNo := Metaclass allSubInstances size. "When traits are present, discount all traits if necessary" Smalltalk at: #Trait ifPresent:[:aClass| (aClass inheritsFrom: ClassDescription) ifTrue:[cdNo := cdNo - aClass instanceCount]]. Smalltalk at: #ClassTrait ifPresent:[:aClass| (aClass inheritsFrom: ClassDescription) ifTrue:[cdNo := cdNo - aClass instanceCount]]. self assert: cdNo = (clsNo + metaclsNo).! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclass (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclass (in category 'testing') ----- testMetaclass "self run: #testMetaclass" self assert: OrderedCollection class class == Metaclass. self assert: Dictionary class class == Metaclass. self assert: Object class class == Metaclass. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassName (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassName (in category 'testing') ----- testMetaclassName "self run: #testMetaclassName" self assert: Dictionary class name = 'Dictionary class'. self assert: OrderedCollection class name = 'OrderedCollection class'. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassNumberOfInstances (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassNumberOfInstances (in category 'testing') ----- testMetaclassNumberOfInstances "self run: #testMetaclassNumberOfInstances" self assert: Dictionary class allInstances size = 1. self assert: OrderedCollection class allInstances size = 1.! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassPointOfCircularity (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassPointOfCircularity (in category 'testing') ----- testMetaclassPointOfCircularity "self run: #testMetaclassPointOfCircularity" self assert: Metaclass class instanceCount = 1. self assert: Metaclass class someInstance == Metaclass. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclass (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclass (in category 'testing') ----- testMetaclassSuperclass "self run: #testMetaclassSuperclass" self assert: Dictionary class superclass == HashedCollection class. self assert: OrderedCollection class superclass == SequenceableCollection class. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclassHierarchy (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testMetaclassSuperclassHierarchy (in category 'testing') ----- testMetaclassSuperclassHierarchy "self run: #testMetaclassSuperclassHierarchy" | s | self assert: SequenceableCollection class instanceCount = 1. self assert: Collection class instanceCount = 1. self assert: Object class instanceCount = 1. self assert: ProtoObject class instanceCount = 1. s := OrderedCollection new. s add: SequenceableCollection class. s add: Collection class. s add: Object class. s add: ProtoObject class. s add: Class. s add: ClassDescription. s add: Behavior. s add: Object. s add: ProtoObject. self assert: OrderedCollection class allSuperclasses = s. ! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testObjectAllSubclasses (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testObjectAllSubclasses (in category 'testing') ----- testObjectAllSubclasses "self run: #testObjectAllSubclasses" | n2 | n2 := Object allSubclasses size. self assert: n2 = (Object allSubclasses select: [:cls | cls class class == Metaclass or: [cls class == Metaclass]]) size! Item was changed: + ----- Method: BasicBehaviorClassMetaclassTest>>testSuperclass (in category 'tests') ----- - ----- Method: BasicBehaviorClassMetaclassTest>>testSuperclass (in category 'testing') ----- testSuperclass "self run: #testSuperclass" | s | self assert: Dictionary superclass == HashedCollection. self assert: OrderedCollection superclass == SequenceableCollection. s := OrderedCollection new. s add: SequenceableCollection. s add: Collection. s add: Object. s add: ProtoObject. self assert: OrderedCollection allSuperclasses = s. ! Item was changed: + ----- Method: CategorizerTest>>testClassifyNewElementNewCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testClassifyNewElementNewCategory (in category 'testing') ----- testClassifyNewElementNewCategory categorizer classify: #f under: #nice. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'') (''nice'' f) '! Item was changed: + ----- Method: CategorizerTest>>testClassifyNewElementOldCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testClassifyNewElementOldCategory (in category 'testing') ----- testClassifyNewElementOldCategory categorizer classify: #f under: #unreal. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'' f) '! Item was changed: + ----- Method: CategorizerTest>>testClassifyOldElementNewCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testClassifyOldElementNewCategory (in category 'testing') ----- testClassifyOldElementNewCategory categorizer classify: #e under: #nice. self assert: categorizer printString = '(''as yet unclassified'' d) (''abc'' a b c) (''unreal'') (''nice'' e) '! Item was changed: + ----- Method: CategorizerTest>>testClassifyOldElementOldCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testClassifyOldElementOldCategory (in category 'testing') ----- testClassifyOldElementOldCategory categorizer classify: #e under: #unreal. self assert: categorizer printString = '(''as yet unclassified'' d) (''abc'' a b c) (''unreal'' e) '! Item was changed: + ----- Method: CategorizerTest>>testDefaultCategoryIsTransient (in category 'tests') ----- - ----- Method: CategorizerTest>>testDefaultCategoryIsTransient (in category 'testing') ----- testDefaultCategoryIsTransient "Test that category 'as yet unclassified' disapears when all it's elements are removed'" categorizer classifyAll: #(d e) under: #abc. self assert: categorizer printString = '(''abc'' a b c d e) (''unreal'') '! Item was changed: + ----- Method: CategorizerTest>>testNoSpecialCategories (in category 'tests') ----- - ----- Method: CategorizerTest>>testNoSpecialCategories (in category 'testing') ----- testNoSpecialCategories SystemNavigation allClasses do: [:class | {class. class class} do: [:classOrMetaClass | self assert: (classOrMetaClass organization categories includes: Categorizer allCategory) not description: ('{1} must not have the all-category in its organization.' format: {class name}). self assert: (classOrMetaClass organization isEmpty or: [ (classOrMetaClass organization categories includes: Categorizer nullCategory) not]) description: ('{1} must not have the null-category in its organization.' format: {class name}).]].! Item was changed: + ----- Method: CategorizerTest>>testNullCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testNullCategory (in category 'testing') ----- testNullCategory "Test that category 'as yet unclassified' disapears when all it's elements are removed'" | aCategorizer | aCategorizer := Categorizer defaultList: #(). self assert: aCategorizer printString = '(''as yet unclassified'') '. self assert: aCategorizer categories = #('no messages'). aCategorizer classify: #a under: #b. self assert: aCategorizer printString = '(''b'' a) '. self assert: aCategorizer categories = #(b).! Item was changed: + ----- Method: CategorizerTest>>testRemoveEmptyCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveEmptyCategory (in category 'testing') ----- testRemoveEmptyCategory categorizer removeCategory: #unreal. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) '! Item was changed: + ----- Method: CategorizerTest>>testRemoveExistingElement (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveExistingElement (in category 'testing') ----- testRemoveExistingElement categorizer removeElement: #a. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' b c) (''unreal'') '! Item was changed: + ----- Method: CategorizerTest>>testRemoveNonEmptyCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveNonEmptyCategory (in category 'testing') ----- testRemoveNonEmptyCategory self should: [categorizer removeCategory: #abc] raise: Error. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'') '! Item was changed: + ----- Method: CategorizerTest>>testRemoveNonExistingCategory (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveNonExistingCategory (in category 'testing') ----- testRemoveNonExistingCategory categorizer removeCategory: #nice. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'') '! Item was changed: + ----- Method: CategorizerTest>>testRemoveNonExistingElement (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveNonExistingElement (in category 'testing') ----- testRemoveNonExistingElement categorizer removeElement: #f. self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'') '! Item was changed: + ----- Method: CategorizerTest>>testRemoveThenRename (in category 'tests') ----- - ----- Method: CategorizerTest>>testRemoveThenRename (in category 'testing') ----- testRemoveThenRename categorizer removeCategory: #unreal. categorizer renameCategory: #abc toBe: #unreal. self assert: categorizer printString = '(''as yet unclassified'' d e) (''unreal'' a b c) '! Item was changed: + ----- Method: CategorizerTest>>testUnchanged (in category 'tests') ----- - ----- Method: CategorizerTest>>testUnchanged (in category 'testing') ----- testUnchanged self assert: categorizer printString = '(''as yet unclassified'' d e) (''abc'' a b c) (''unreal'') '! Item was changed: + ----- Method: ClassBuilderTest>>testByteVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testByteVariableSubclass (in category 'testing - format') ----- testByteVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object variableByteSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self assert: (subClass isBytes). self deny: (subClass isWords). self deny: (subClass isShorts). self deny: (subClass isLongs). subClass removeFromSystem. "pointer classes" self should:[self makeIVarsSubclassOf: baseClass] raise: Error. self should:[self makeVariableSubclassOf: baseClass] raise: Error. self should:[self makeWeakSubclassOf: baseClass] raise: Error. "bit classes" subClass := self makeByteVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self assert: (subClass isBytes). self deny: (subClass isWords). self deny: (subClass isShorts). self deny: (subClass isLongs). subClass removeFromSystem. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleWordVariableSubclassOf: baseClass] raise: Error. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testChangeToVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testChangeToVariableSubclass (in category 'testing - format') ----- testChangeToVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ baseClass := Object variableSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testCompiledMethodSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testCompiledMethodSubclass (in category 'testing - format') ----- testCompiledMethodSubclass "Ensure that the invariants for superclass/subclass format are preserved" [self deny: (Smalltalk includesKey: self subClassName). baseClass := CompiledMethod variableByteSubclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self deny: baseClass isPointers. self assert: baseClass isVariable. self deny: baseClass isWeak. self assert: baseClass isBytes. self assert: baseClass isCompiledMethodClass. self deny: baseClass isWords. self deny: baseClass isShorts. self deny: baseClass isLongs. "Now move it to be a sibling; test it maintains its CompiledMethod-ness" baseClass := ByteArray variableByteSubclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self deny: baseClass isPointers. self assert: baseClass isVariable. self deny: baseClass isWeak. self assert: baseClass isBytes. self assert: baseClass isCompiledMethodClass. self deny: baseClass isWords. self deny: baseClass isShorts. self deny: baseClass isLongs] ensure: [self cleanup]! Item was changed: + ----- Method: ClassBuilderTest>>testDoubleByteVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testDoubleByteVariableSubclass (in category 'testing - format') ----- testDoubleByteVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object variableDoubleByteSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isShorts). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isWords). self deny: (subClass isLongs). subClass removeFromSystem. "pointer classes" self should:[self makeIVarsSubclassOf: baseClass] raise: Error. self should:[self makeVariableSubclassOf: baseClass] raise: Error. self should:[self makeWeakSubclassOf: baseClass] raise: Error. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleWordVariableSubclassOf: baseClass] raise: Error. subClass := self makeDoubleByteVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isShorts). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isWords). self deny: (subClass isLongs). subClass removeFromSystem. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testDoubleWordVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testDoubleWordVariableSubclass (in category 'testing - format') ----- testDoubleWordVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object variableDoubleWordSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isLongs). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isShorts). self deny: (subClass isWords). subClass removeFromSystem. "pointer classes" self should:[self makeIVarsSubclassOf: baseClass] raise: Error. self should:[self makeVariableSubclassOf: baseClass] raise: Error. self should:[self makeWeakSubclassOf: baseClass] raise: Error. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. subClass := self makeDoubleWordVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isLongs). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isShorts). self deny: (subClass isWords). subClass removeFromSystem. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testDuplicateClassVariableError (in category 'tests - reshape') ----- - ----- Method: ClassBuilderTest>>testDuplicateClassVariableError (in category 'testing - reshape') ----- testDuplicateClassVariableError baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: 'TestVar' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self should:[ subClass := baseClass subclass: self subClassName instanceVariableNames: '' classVariableNames: 'TestVar' poolDictionaries: '' category: self categoryNameForTemporaryClasses ] raise: DuplicateVariableError. [subClass := baseClass subclass: self subClassName instanceVariableNames: '' classVariableNames: 'TestVar' poolDictionaries: '' category: self categoryNameForTemporaryClasses ] on: DuplicateVariableError do:[:ex| self assert: ex superclass == baseClass. self assert: ex variable = 'TestVar'. ex resume. ]. baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self should:[ baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: 'TestVar' poolDictionaries: '' category: self categoryNameForTemporaryClasses. ] raise: DuplicateVariableError. [baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: 'TestVar' poolDictionaries: '' category: self categoryNameForTemporaryClasses. ] on: DuplicateVariableError do:[:ex| self assert: ex superclass == baseClass. self assert: ex variable = 'TestVar'. ex resume. ].! Item was changed: + ----- Method: ClassBuilderTest>>testDuplicateInstanceVariableError (in category 'tests - reshape') ----- - ----- Method: ClassBuilderTest>>testDuplicateInstanceVariableError (in category 'testing - reshape') ----- testDuplicateInstanceVariableError | didRaise | "Define 'var' in a superclass." baseClass := Object subclass: self baseClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "Ensure trying to define a subclass with same var errors." didRaise := false. [baseClass subclass: self subClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses ] on: DuplicateVariableError do: [ : err | didRaise := true. self assert: err superclass == baseClass. self assert: err variable = 'var' ]. self assert: didRaise. "Prepare for next test: Remove 'var' from superclass." baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "Define a subclass without 'var'..." subClass := baseClass subclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "... but with a subclass of THAT, with 'var' defined." subSubClass := subClass subclass: self subSubClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "... as well as a different base class with 'var' already defined..." baseClass2 := Object subclass: (self baseClassName,'2') asSymbol instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "...and now try to move the middle subClass, whose subclass (a.k.a., subSubClass) defines 'var', to the new baseClass which also defines 'var'." didRaise := false. [baseClass2 subclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses ] on: DuplicateVariableError do: [ : err | didRaise := true. self assert: err superclass == baseClass2. self assert: err variable = 'var' ]. self assert: didRaise! Item was changed: + ----- Method: ClassBuilderTest>>testMoveVarFromSubToSuperclass (in category 'tests - reshape') ----- - ----- Method: ClassBuilderTest>>testMoveVarFromSubToSuperclass (in category 'testing - reshape') ----- testMoveVarFromSubToSuperclass | baseInst subInst | baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. subClass := baseClass subclass: self subClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. subClass compile: 'subGet ^var'. subClass compile: 'subSet: v var := v'. self assert:[baseClass instSize = 0]. self assert:[subClass instSize = 1]. baseInst := baseClass new. subInst := subClass new. subInst instVarAt: 1 put: 123. self assert: (subInst instVarAt: 1) = 123. self assert: (subInst subGet) = 123. [baseClass := Object subclass: self baseClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. ] on: DuplicateVariableError do:[:ex| ex resume]. baseClass compile: 'superGet ^var'. baseClass compile: 'superSet: v var := v'. self assert:[baseClass instSize = 1]. self assert:[subClass instSize = 2]. "the assumption here is that an existing value is propagated up" self assert: (baseInst instVarAt: 1) = nil. self assert: (subInst instVarAt: 1) = 123. self assert: (subInst instVarAt: 2) = 123. "the assumption below is that the subclass binds to the local scope not the outer one, which is in line with common name space approaches." subInst superSet: 666. subInst subSet: 321. self assert: (subInst instVarAt: 1) = 666. self assert: (subInst instVarAt: 2) = 321. self assert: (subInst superGet) = 666. self assert: (subInst subGet) = 321. subClass := baseClass subclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self assert:[baseClass instSize = 1]. self assert:[subClass instSize = 1]. "the assumption here is that the current (subclass) value is propagated up" self assert: (subInst instVarAt: 1) = 321. self assert: (subInst subGet) = 321. ! Item was changed: + ----- Method: ClassBuilderTest>>testMoveVarFromSuperToSubclass (in category 'tests - reshape') ----- - ----- Method: ClassBuilderTest>>testMoveVarFromSuperToSubclass (in category 'testing - reshape') ----- testMoveVarFromSuperToSubclass | baseInst subInst | baseClass := Object subclass: self baseClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. baseClass compile: 'superGet ^var'. baseClass compile: 'superSet: v var := v'. subClass := baseClass subclass: self subClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. subClass compile: 'subGet ^var'. subClass compile: 'subSet: v var := v'. self assert:[baseClass instSize = 1]. self assert:[subClass instSize = 1]. baseInst := baseClass new. subInst := subClass new. baseInst instVarAt: 1 put: 42. subInst instVarAt: 1 put: 123. self assert: (baseInst instVarAt: 1) = 42. self assert: (subInst instVarAt: 1) = 123. self assert: (subInst subGet) = 123. [subClass := baseClass subclass: self subClassName instanceVariableNames: 'var' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses ] on: DuplicateVariableError do:[:ex| ex resume]. self assert:[baseClass instSize = 1]. self assert:[subClass instSize = 2]. self assert: (baseInst instVarAt: 1) = 42. "the assumption below is that for duplicate variables the values get duplicated too. this isn't strictly necessary; what we really need is that the old var doesn't get nuked but it has some advantages when moving vars up the hierarchy" self assert: (subInst instVarAt: 1) = 123. self assert: (subInst instVarAt: 2) = 123. self assert: (subInst superGet) = 123. self assert: (subInst subGet) = 123. "the assumption below is that the subclass binds to the local scope not the outer one, which is in line with common name space approaches." subInst superSet: 666. subInst subSet: 321. self assert: (subInst instVarAt: 1) = 666. self assert: (subInst instVarAt: 2) = 321. self assert: (subInst superGet) = 666. self assert: (subInst subGet) = 321. baseClass removeSelector: #superGet. baseClass removeSelector: #superSet:. baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. self assert:[baseClass instSize = 0]. self assert:[subClass instSize = 1]. self assert: (subInst instVarAt: 1) = 321. self assert: (subInst subGet) = 321. ! Item was changed: + ----- Method: ClassBuilderTest>>testNewUniclass (in category 'tests - uniclass') ----- - ----- Method: ClassBuilderTest>>testNewUniclass (in category 'testing - uniclass') ----- testNewUniclass baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. "Note that you have to denote a new base class to be capable of spawning uni classes. See Object class >> #isUniClass for more information." baseClass class compile: ('isUniClass\ ^ self ~~ {1}' withCRs format: {self baseClassName}) classified: 'instance creation'. subClass := baseClass newSubclass. self assert: subClass isUniClass; assert: subClass environment ~~ baseClass environment; assert: subClass category = Object categoryForUniclasses; assert: (baseClass organization categoryOfElement: subClass name) isNil. self deny: subClass isObsolete. subClass removeFromSystem. self assert: subClass isObsolete.! Item was changed: + ----- Method: ClassBuilderTest>>testSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testSubclass (in category 'testing - format') ----- testSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object subclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self assert: (subClass isPointers). self deny: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "pointer classes" subClass := self makeIVarsSubclassOf: baseClass. self assert: (subClass isPointers). self deny: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeVariableSubclassOf: baseClass. self assert: (subClass isPointers). self assert:(subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeWeakSubclassOf: baseClass. self assert: (subClass isPointers). self assert:(subClass isVariable). self assert:(subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "bit classes" subClass := self makeByteVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self assert: (subClass isBytes). subClass removeFromSystem. subClass := self makeWordVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testSubclassWithInstanceVariables (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testSubclassWithInstanceVariables (in category 'testing - format') ----- testSubclassWithInstanceVariables "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object subclass: self baseClassName instanceVariableNames: 'var1 var2' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self assert: (subClass isPointers). self deny: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "pointer classes" subClass := self makeIVarsSubclassOf: baseClass. self assert: (subClass isPointers). self deny: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeVariableSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeWeakSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testVariableSubclass (in category 'testing - format') ----- testVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object variableSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ "pointer classes" subClass := self makeNormalSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeIVarsSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeVariableSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeWeakSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testWeakSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testWeakSubclass (in category 'testing - format') ----- testWeakSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object weakSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ "pointer classes" subClass := self makeNormalSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeIVarsSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeVariableSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self deny: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. subClass := self makeWeakSubclassOf: baseClass. self assert: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWeak). self deny: (subClass isBytes). subClass removeFromSystem. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeWordVariableSubclassOf: baseClass] raise: Error. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassBuilderTest>>testWordVariableSubclass (in category 'tests - format') ----- - ----- Method: ClassBuilderTest>>testWordVariableSubclass (in category 'testing - format') ----- testWordVariableSubclass "Ensure that the invariants for superclass/subclass format are preserved" baseClass := Object variableWordSubclass: self baseClassName instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self categoryNameForTemporaryClasses. [ subClass := self makeNormalSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWords). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isShorts). self deny: (subClass isLongs). subClass removeFromSystem. "pointer classes" self should:[self makeIVarsSubclassOf: baseClass] raise: Error. self should:[self makeVariableSubclassOf: baseClass] raise: Error. self should:[self makeWeakSubclassOf: baseClass] raise: Error. "bit classes" self should:[self makeByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleByteVariableSubclassOf: baseClass] raise: Error. self should:[self makeDoubleWordVariableSubclassOf: baseClass] raise: Error. subClass := self makeWordVariableSubclassOf: baseClass. self deny: (subClass isPointers). self assert: (subClass isVariable). self assert: (subClass isWords). self deny: (subClass isWeak). self deny: (subClass isBytes). self deny: (subClass isShorts). self deny: (subClass isLongs). subClass removeFromSystem. ] ensure:[self cleanup].! Item was changed: + ----- Method: ClassTest>>testAddInstVarName (in category 'tests') ----- - ----- Method: ClassTest>>testAddInstVarName (in category 'testing') ----- testAddInstVarName "self run: #testAddInstVarName" | tutu | tutu := Smalltalk at: className. tutu addInstVarName: 'x'. self assert: (tutu instVarNames = #('x')). tutu addInstVarName: 'y'. self assert: (tutu instVarNames = #('x' 'y')). tutu selectorsAndMethodsDo: [:s :m| self assert: m methodClassAssociation == (Smalltalk bindingOf: className)] ! Item was changed: + ----- Method: ClassTest>>testChangeClassOf (in category 'tests') ----- - ----- Method: ClassTest>>testChangeClassOf (in category 'testing') ----- testChangeClassOf "Exercise primitiveChangeClass (primitive 115) for a common use case. This should pass for any Squeak image format (but failed for image format 68002 prior to VM fix)" self shouldnt: [Inspector new primitiveChangeClassTo: CompiledMethodInspector new] raise: Error! Item was changed: + ----- Method: ClassTest>>testCompileAll (in category 'tests - compiling') ----- - ----- Method: ClassTest>>testCompileAll (in category 'testing - compiling') ----- testCompileAll "We expect this to succeed." ClassTest compileAll.! Item was changed: + ----- Method: ClassTest>>testRenaming (in category 'tests') ----- - ----- Method: ClassTest>>testRenaming (in category 'testing') ----- testRenaming "self debug: #testRenaming" "self run: #testRenaming" | oldName newMetaclassName class | oldName := className. newMetaclassName := (renamedName, #' class') asSymbol. class := Smalltalk at: oldName. class class compile: 'dummyMeth'. class rename: renamedName. self assert: class name = renamedName. self assert: (ChangeSet current changedClassNames includes: renamedName). self assert: (ChangeSet current changedClassNames includes: newMetaclassName). ! Item was changed: + ----- Method: CompiledMethodTest>>expectedFailures (in category 'failures') ----- - ----- Method: CompiledMethodTest>>expectedFailures (in category 'testing') ----- expectedFailures Smalltalk isRunningCog ifTrue: [ ^super expectedFailures ]. ^#( "Not supported by the interpreter VM. See method comments for details" testPerformInSuperclassCanExecutelongMethodWithTemps )! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testEmbeddingSourceCode (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testEmbeddingSourceCode (in category 'testing') ----- testEmbeddingSourceCode | trailer newTrailer code | trailer := CompiledMethodTrailer new. code := 'foo'. trailer sourceCode: code. newTrailer := trailer testEncoding. self assert: (trailer kind == #EmbeddedSourceQCompress ). self assert: (newTrailer sourceCode = code). "the last bytecode index must be at 0" self assert: (newTrailer endPC = 0). code := 'testEmbeddingSourceCode | trailer newTrailer code | trailer := CompiledMethodTrailer new. trailer sourceCode: code. newTrailer := trailer testEncoding. self assert: (newTrailer sourceCode = code).'. trailer sourceCode: code. self assert: (trailer kind == #EmbeddedSourceZip ). newTrailer := trailer testEncoding. self assert: (newTrailer sourceCode = code). "the last bytecode index must be at 0" self assert: (newTrailer endPC = 0). ! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testEmbeddingTempNames (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testEmbeddingTempNames (in category 'testing') ----- testEmbeddingTempNames | trailer newTrailer code | trailer := CompiledMethodTrailer new. code := 'foo'. trailer tempNames: code. newTrailer := trailer testEncoding. self assert: (trailer kind == #TempsNamesQCompress ). self assert: (newTrailer tempNames = code). "the last bytecode index must be at 0" self assert: (newTrailer endPC = 0). code := 'testEmbeddingSourceCode | trailer newTrailer code | trailer := CompiledMethodTrailer new. trailer sourceCode: code. newTrailer := trailer testEncoding. self assert: (newTrailer sourceCode = code).'. trailer tempNames: code. self assert: (trailer kind == #TempsNamesZip ). newTrailer := trailer testEncoding. self assert: (newTrailer tempNames = code). "the last bytecode index must be at 0" self assert: (newTrailer endPC = 0). ! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testEncodingNoTrailer (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testEncodingNoTrailer (in category 'testing') ----- testEncodingNoTrailer | trailer | trailer := CompiledMethodTrailer new. "by default it should be a no-trailer" self assert: (trailer kind == #NoTrailer ). self assert: (trailer size = 1). trailer := trailer testEncoding. self assert: (trailer kind == #NoTrailer ). self assert: (trailer size = 1). "the last bytecode index must be at 0" self assert: (trailer endPC = 0). ! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testEncodingSourcePointer (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testEncodingSourcePointer (in category 'testing') ----- testEncodingSourcePointer | trailer | trailer := CompiledMethodTrailer new. CompiledMethod allInstancesDo: [:method | | ptr | trailer method: method. self assert: ( (ptr := method sourcePointer) == trailer sourcePointer). "the last bytecode index must be at 0" ptr ~= 0 ifTrue: [ self assert: (method endPC = trailer endPC) ]. ].! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testEncodingVarLengthSourcePointer (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testEncodingVarLengthSourcePointer (in category 'testing') ----- testEncodingVarLengthSourcePointer | trailer newTrailer | trailer := CompiledMethodTrailer new. trailer sourcePointer: 1. newTrailer := trailer testEncoding. self assert: (newTrailer sourcePointer = 1). trailer sourcePointer: 16r100000000000000. newTrailer := trailer testEncoding. self assert: (newTrailer sourcePointer = 16r100000000000000). "the last bytecode index must be at 0" self assert: (newTrailer endPC = 0). ! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testSourceByIdentifierEncoding (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testSourceByIdentifierEncoding (in category 'testing') ----- testSourceByIdentifierEncoding | trailer id | trailer := CompiledMethodTrailer new. id := UUID new asString. trailer sourceIdentifier: id. self assert: (trailer kind == #SourceByStringIdentifier ). trailer := trailer testEncoding. self assert: (trailer kind == #SourceByStringIdentifier ). self assert: (trailer sourceIdentifier = id). "the last bytecode index must be at 0" self assert: (trailer endPC = 0). ! Item was changed: + ----- Method: CompiledMethodTrailerTest>>testSourceBySelectorEncoding (in category 'tests') ----- - ----- Method: CompiledMethodTrailerTest>>testSourceBySelectorEncoding (in category 'testing') ----- testSourceBySelectorEncoding | trailer | trailer := CompiledMethodTrailer new. trailer setSourceBySelector. self assert: (trailer kind == #SourceBySelector ). self assert: (trailer size = 1). trailer := trailer testEncoding. self assert: (trailer kind == #SourceBySelector ). self assert: (trailer size = 1). "the last bytecode index must be at 0" self assert: (trailer endPC = 0). ! Item was changed: + ----- Method: ComplexTest>>testBug1 (in category 'tests - bugs') ----- - ----- Method: ComplexTest>>testBug1 (in category 'testing - bugs') ----- testBug1 self assert: (0.5 * (2+0i) ln) exp = (0.5 * 2 ln) exp.! Item was changed: + ----- Method: ComplexTest>>testEquality (in category 'tests') ----- - ----- Method: ComplexTest>>testEquality (in category 'testing') ----- testEquality "self run: #testEquality" "self debug: #testEquality" self assert: 0i = 0. self assert: (2 - 5i) = ((1 -4 i) + (1 - 1i)). self assert: 0i isZero. self deny: (1 + 3 i) = 1. self deny: (1 + 3 i) = (1 + 2i). "Some more stuff" self deny: (1 i) = nil. self deny: nil = (1 i). self deny: (1 i) = #(1 2 3). self deny: #(1 2 3) = (1 i). self deny: (1 i) = 0. self deny: 0 = (1 i). self assert: (1 + 0 i) = 1. self assert: 1 = (1+ 0 i). self assert: (1 + 0 i) = 1.0. self assert: 1.0 = (1+ 0 i). self assert: (1/2 + 0 i) = (1/2). self assert: (1/2) = (1/2+ 0 i).! Item was changed: + ----- Method: DelayTest>>testBounds (in category 'tests - limits') ----- - ----- Method: DelayTest>>testBounds (in category 'testing-limits') ----- testBounds "self run: #testBounds" self should: [Delay forMilliseconds: -1] raise: Error. "We expect these to succeed." Delay forMilliseconds: SmallInteger maxVal + 1. (Delay forMilliseconds: Float pi) wait. "Wait 3ms" ! Item was changed: + ----- Method: DelayTest>>testMultiProcessWaitOnSameDelay (in category 'tests - limits') ----- - ----- Method: DelayTest>>testMultiProcessWaitOnSameDelay (in category 'testing-limits') ----- testMultiProcessWaitOnSameDelay "Ensure that waiting on the same delay from multiple processes raises an error" | delay p1 p2 wasRun | delay := Delay forSeconds: 1. wasRun := false. p1 := [delay wait] forkAt: Processor activePriority+1. p2 := [ self should:[delay wait] raise: Error. wasRun := true. ] forkAt: Processor activePriority+1. p1 terminate. p2 terminate. self assert: wasRun. ! Item was changed: + ----- Method: DelayTest>>testMultiSchedule (in category 'tests - limits') ----- - ----- Method: DelayTest>>testMultiSchedule (in category 'testing-limits') ----- testMultiSchedule "Ensure that scheduling the same delay twice raises an error" | delay | delay := Delay forSeconds: 1. delay schedule. self should:[delay schedule] raise: Error. ! Item was changed: + ----- Method: DependentsArrayTest>>testAddingTwice (in category 'tests') ----- - ----- Method: DependentsArrayTest>>testAddingTwice (in category 'testing') ----- testAddingTwice | test dep2 deps | test := Object new. dep2 := String with: $z with: $u with: $t. test addDependent: String new. test addDependent: dep2. Smalltalk garbageCollect. "this will make first dependent vanish, replaced by nil" test addDependent: dep2. deps := test dependents. self should: [deps asIdentitySet size = deps size] description: 'No object should be added twice in dependents'! Item was changed: + ----- Method: DependentsArrayTest>>testCanDiscardEdits (in category 'tests') ----- - ----- Method: DependentsArrayTest>>testCanDiscardEdits (in category 'testing') ----- testCanDiscardEdits "self debug: #testCanDiscardEdits." | anObject aView | anObject := Object new. "A Project may always discard edits." aView := Project new. anObject addDependent: Object new. "this entry should be garbage collected" anObject addDependent: aView. Smalltalk garbageCollect. "force garbage collection" self should: [anObject dependents size = 1] description: 'first dependent of anObject should have been collected, second should not'. self shouldnt: [anObject canDiscardEdits] description: 'anObject cannot discard edits because aView is a dependent of anObject and aView has unaccepted edits'.! Item was changed: + ----- Method: DependentsArrayTest>>testSize (in category 'tests') ----- - ----- Method: DependentsArrayTest>>testSize (in category 'testing') ----- testSize self assert: (DependentsArray with: nil) size = 0; assert: (DependentsArray with: nil with: 1 with: nil) size = 1; assert: (DependentsArray with: 1 with: 3) size = 2; assert: (DependentsArray with: nil with: nil with: nil) size = 0! Item was changed: + ----- Method: ExtendedNumberParserTest>>testFractionPartWithoutIntegerPart (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testFractionPartWithoutIntegerPart (in category 'testing') ----- testFractionPartWithoutIntegerPart "The integer part before the decimal is optional" self assert: (ExtendedNumberParser parse: '.5') = (1/2). self assert: (ExtendedNumberParser parse: '.5') isFloat. self assert: (ExtendedNumberParser parse: '.3e2') = 30. self assert: (ExtendedNumberParser parse: '.3e2') isFloat. self assert: (ExtendedNumberParser parse: '-.4e2') = -40. self assert: (ExtendedNumberParser parse: '-.4e2') isFloat. self assert: (ExtendedNumberParser parse: '+.5e2') = 50. self assert: (ExtendedNumberParser parse: '+.5e2') isFloat. self assert: (ExtendedNumberParser parse: '+.6e+2') = 60. self assert: (ExtendedNumberParser parse: '+.6e+2') isFloat. self assert: (ExtendedNumberParser parse: '-.7e+2') = -70. self assert: (ExtendedNumberParser parse: '-.7e+2') isFloat. self assert: (ExtendedNumberParser parse: '+2r.1e-2') = (1/8). self assert: (ExtendedNumberParser parse: '+2r.1e-2') isFloat. self assert: (ExtendedNumberParser parse: '-4r.1e-2') = (-1/64). self assert: (ExtendedNumberParser parse: '-4r.1e-2') isFloat.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testIntegerPartWithoutFraction (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testIntegerPartWithoutFraction (in category 'testing') ----- testIntegerPartWithoutFraction "The fraction part after the decimal is optional" self assert: (ExtendedNumberParser parse: '1.') = 1. self assert: (ExtendedNumberParser parse: '1.') isFloat. self assert: (ExtendedNumberParser parse: '3.e2') = 300. self assert: (ExtendedNumberParser parse: '3.e2') isFloat. self assert: (ExtendedNumberParser parse: '-4.e2') = -400. self assert: (ExtendedNumberParser parse: '-4.e2') isFloat. self assert: (ExtendedNumberParser parse: '+5.e2') = 500. self assert: (ExtendedNumberParser parse: '+5.e2') isFloat. self assert: (ExtendedNumberParser parse: '+6.e+2') = 600. self assert: (ExtendedNumberParser parse: '+6.e+2') isFloat. self assert: (ExtendedNumberParser parse: '-7.e+2') = -700. self assert: (ExtendedNumberParser parse: '-7.e+2') isFloat. self assert: (ExtendedNumberParser parse: '+2r1.e-2') = (1/4). self assert: (ExtendedNumberParser parse: '+2r1.e-2') isFloat. self assert: (ExtendedNumberParser parse: '-4r1.e-2') = (-1/16). self assert: (ExtendedNumberParser parse: '-4r1.e-2') isFloat.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testInvalidExponent (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testInvalidExponent (in category 'testing') ----- testInvalidExponent "The leading number is returned, the invalid part is ignored" self assert: (ExtendedNumberParser parse: '1e') = 1. self assert: (ExtendedNumberParser parse: '1eZ') = 1. self assert: (ExtendedNumberParser parse: '+1eW') = 1. self assert: (ExtendedNumberParser parse: '-1eX') = -1. self assert: (ExtendedNumberParser parse: '2e-') = 2. self assert: (ExtendedNumberParser parse: '2e--1') = 2. self assert: (ExtendedNumberParser parse: '2e-+1') = 2. self assert: (ExtendedNumberParser parse: '2e-Z') = 2. self assert: (ExtendedNumberParser parse: '+2e-W') = 2. self assert: (ExtendedNumberParser parse: '-2e-X') = -2. self assert: (ExtendedNumberParser parse: '3e+') = 3. self assert: (ExtendedNumberParser parse: '3e+-') = 3. self assert: (ExtendedNumberParser parse: '3e+-1') = 3. self assert: (ExtendedNumberParser parse: '+3e+W') = 3. self assert: (ExtendedNumberParser parse: '-3e+Z') = -3.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testInvalidRadix (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testInvalidRadix (in category 'testing') ----- testInvalidRadix "The leading number is returned, the invalid part is ignored" self assert: (ExtendedNumberParser parse: '1r') = 1. self assert: (ExtendedNumberParser parse: '+1r') = 1. self assert: (ExtendedNumberParser parse: '-1r') = -1. self assert: (ExtendedNumberParser parse: '-1r+') = -1. self assert: (ExtendedNumberParser parse: '-1r-') = -1. self assert: (ExtendedNumberParser parse: '-2r.') = -2. self assert: (ExtendedNumberParser parse: '-2r-.') = -2. self assert: (ExtendedNumberParser parse: '+2r-.') = 2. self assert: (ExtendedNumberParser parse: '+2r3.') = 2. self assert: (ExtendedNumberParser parse: '+2r.3') = 2. self assert: (ExtendedNumberParser parse: '+2r-.3') = 2.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testInvalidScale (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testInvalidScale (in category 'testing') ----- testInvalidScale "The leading number is returned, the invalid part is ignored" self assert: (ExtendedNumberParser parse: '1s') = 1. self assert: (ExtendedNumberParser parse: '1sZ') = 1. self assert: (ExtendedNumberParser parse: '+1sW') = 1. self assert: (ExtendedNumberParser parse: '-1sX') = -1. self assert: (ExtendedNumberParser parse: '2s-') = 2. self assert: (ExtendedNumberParser parse: '2s--1') = 2. self assert: (ExtendedNumberParser parse: '2s-+1') = 2. self assert: (ExtendedNumberParser parse: '2s-1') = 2. self assert: (ExtendedNumberParser parse: '+2s-2') = 2. self assert: (ExtendedNumberParser parse: '-2s-3') = -2. self assert: (ExtendedNumberParser parse: '3s+') = 3. self assert: (ExtendedNumberParser parse: '3s+-') = 3. self assert: (ExtendedNumberParser parse: '3s+-1') = 3. self assert: (ExtendedNumberParser parse: '+3s+2') = 3. self assert: (ExtendedNumberParser parse: '-3s+3') = -3.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testPositive (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testPositive (in category 'testing') ----- testPositive "A leading + sign is allowed" self assert: (ExtendedNumberParser parse: '+1') = 1. self assert: (ExtendedNumberParser parse: '+22') = 22. self assert: (ExtendedNumberParser parse: '+2r11') = 3. self assert: (ExtendedNumberParser parse: '+2r+101') = 5. self assert: (ExtendedNumberParser parse: '+2r-101') = -5. self assert: (ExtendedNumberParser parse: '-2r+101') = -5. self assert: (ExtendedNumberParser parse: '+1.') isFloat. self assert: (ExtendedNumberParser parse: '+1.') = 1. self assert: (ExtendedNumberParser parse: '+21.') = 21. self assert: (ExtendedNumberParser parse: '+3r21.') = 7. self assert: (ExtendedNumberParser parse: '+3r+201.') = 19. self assert: (ExtendedNumberParser parse: '+3r-201.') = -19. self assert: (ExtendedNumberParser parse: '-3r+201.') = -19.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testPositiveExponent (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testPositiveExponent (in category 'testing') ----- testPositiveExponent "A leading + sign is allowed in exponent" self assert: (ExtendedNumberParser parse: '1e+2') = 100. self assert: (ExtendedNumberParser parse: '1e+2') isInteger. self assert: (ExtendedNumberParser parse: '-1e+2') = -100. self assert: (ExtendedNumberParser parse: '1.e+2') = 100. self assert: (ExtendedNumberParser parse: '1.e+2') isFloat. self assert: (ExtendedNumberParser parse: '-1.0e+2') = -100.! Item was changed: + ----- Method: ExtendedNumberParserTest>>testUppercaseExponent (in category 'tests') ----- - ----- Method: ExtendedNumberParserTest>>testUppercaseExponent (in category 'testing') ----- testUppercaseExponent "An uppercase exponent is allowed" self assert: 0.01 equals: (ExtendedNumberParser parse: '1.00E-2'). self assert: 305.0 equals: (ExtendedNumberParser parse: '3.05D+2').! Item was changed: + ----- Method: FloatTest>>assertIsNegativeZero: (in category 'asserting') ----- - ----- Method: FloatTest>>assertIsNegativeZero: (in category 'accessing') ----- assertIsNegativeZero: aFloat "Assert that aFloat is Float negativeZero" self assert: aFloat = 0.0. self assert: aFloat signBit = 1! Item was changed: + ----- Method: FloatTest>>assertIsPositiveZero: (in category 'asserting') ----- - ----- Method: FloatTest>>assertIsPositiveZero: (in category 'accessing') ----- assertIsPositiveZero: aFloat "Assert that aFloat is Float zero (the positive one)" self assert: aFloat = 0.0. self assert: aFloat signBit = 0! Item was changed: + ----- Method: FloatTest>>test32bitGradualUnderflow (in category 'tests - IEEE 754') ----- - ----- Method: FloatTest>>test32bitGradualUnderflow (in category 'IEEE 754') ----- test32bitGradualUnderflow "method asIEEE32BitWord did not respect IEEE gradual underflow" | conv expected exponentPart | "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign except when 2reeeeeeee isZero, which is a gradual underflow: 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-126) * sign and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" "case 1: This example is the first gradual underflow case" conv := 2r0.11111111111111111111111e-126 asIEEE32BitWord. "expected float encoded as sign/exponent/mantissa (whithout leading 1 or 0)" exponentPart := 0. expected := exponentPart bitOr: 2r11111111111111111111111. self assert: expected = conv. "case 2: smallest number" conv := 2r0.00000000000000000000001e-126 asIEEE32BitWord. expected := exponentPart bitOr: 2r1. self assert: expected = conv. "case 3: round to nearest even also in underflow cases... here round to upper" conv := 2r0.000000000000000000000011e-126 asIEEE32BitWord. expected := exponentPart bitOr: 2r10. self assert: expected = conv. "case 4: round to nearest even also in underflow cases... here round to lower" conv := 2r0.000000000000000000000101e-126 asIEEE32BitWord. expected := exponentPart bitOr: 2r10. self assert: expected = conv. "case 5: round to nearest even also in underflow cases... here round to upper" conv := 2r0.0000000000000000000001011e-126 asIEEE32BitWord. expected := exponentPart bitOr: 2r11. self assert: expected = conv. ! Item was changed: + ----- Method: FloatTest>>test32bitRoundingMode (in category 'tests - IEEE 754') ----- - ----- Method: FloatTest>>test32bitRoundingMode (in category 'IEEE 754') ----- test32bitRoundingMode "method asIEEE32BitWord did not respect IEEE default rounding mode" | conv expected exponentPart | "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign except when 2reeeeeeee isZero, which is a gradual underflow: 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-127) * sign and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" "This example has two extra bits in mantissa for testing rounding mode case 1: should obviously round to upper" conv := 2r1.0000000000000000000000111e25 asIEEE32BitWord. "expected float encoded as sign/exponent/mantissa (whithout leading 1)" exponentPart := 25+127 bitShift: 23. "127 is 2r01111111 or 16r7F" expected := exponentPart bitOr: 2r10. self assert: expected = conv. "case 2: exactly in the mid point of two 32 bit float: round toward nearest even (to upper)" conv := 2r1.0000000000000000000000110e25 asIEEE32BitWord. expected := exponentPart bitOr: 2r10. self assert: expected = conv. "case 3: exactly in the mid point of two 32 bit float: round toward nearest even (to lower)" conv := 2r1.0000000000000000000000010e25 asIEEE32BitWord. expected := exponentPart bitOr: 2r0. self assert: expected = conv. "case 4: obviously round to upper" conv := 2r1.0000000000000000000000011e25 asIEEE32BitWord. expected := exponentPart bitOr: 2r1. self assert: expected = conv. ! Item was changed: + ----- Method: FloatTest>>testCeiling (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testCeiling (in category 'testing - conversion') ----- testCeiling self assert: 1.0 ceiling = 1. self assert: 1.1 ceiling = 2. self assert: -2.0 ceiling = -2. self assert: -2.1 ceiling = -2.! Item was changed: + ----- Method: FloatTest>>testCharacterization (in category 'tests - characterization') ----- - ----- Method: FloatTest>>testCharacterization (in category 'characterization') ----- testCharacterization "Test the largest finite representable floating point value" self assert: Float fmax successor = Float infinity. self assert: Float infinity predecessor = Float fmax. self assert: Float fmax negated predecessor = Float negativeInfinity. self assert: Float negativeInfinity successor = Float fmax negated. "Test the smallest positive representable floating point value" self assert: Float fmin predecessor = 0.0. self assert: 0.0 successor = Float fmin. self assert: Float fmin negated successor = 0.0. self assert: 0.0 predecessor = Float fmin negated. "Test the relative precision" self assert: Float one + Float epsilon > Float one. self assert: Float one + Float epsilon = Float one successor. self assert: Float one + (Float epsilon / Float radix) = Float one. "Test maximum and minimum exponent" self assert: Float fmax exponent = Float emax. self assert: Float fminNormalized exponent = Float emin. Float denormalized ifTrue: [ self assert: Float fminDenormalized exponent = (Float emin + 1 - Float precision)]. "Alternative tests for maximum and minimum" self assert: (Float radix - Float epsilon) * (Float radix raisedTo: Float emax) = Float fmax. self assert: Float epsilon * (Float radix raisedTo: Float emin) = Float fmin. "Test sucessors and predecessors" self assert: Float one predecessor successor = Float one. self assert: Float one successor predecessor = Float one. self assert: Float one negated predecessor successor = Float one negated. self assert: Float one negated successor predecessor = Float one negated. self assert: Float infinity successor = Float infinity. self assert: Float negativeInfinity predecessor = Float negativeInfinity. self assertIsNegativeZero: Float fmin negated successor. self assert: Float nan predecessor isNaN. self assert: Float nan successor isNaN. "SPECIFIC FOR IEEE 754 double precision - 64 bits" self assert: Float fmax hex = '7FEFFFFFFFFFFFFF'. self assert: Float fminDenormalized hex = '0000000000000001'. self assert: Float fminNormalized hex = '0010000000000000'. self assert: 0.0 hex = '0000000000000000'. self assert: Float negativeZero hex = '8000000000000000'. self assert: Float one hex = '3FF0000000000000'. self assert: Float infinity hex = '7FF0000000000000'. self assert: Float negativeInfinity hex = 'FFF0000000000000'.! Item was changed: + ----- Method: FloatTest>>testCloseTo (in category 'tests - compare') ----- - ----- Method: FloatTest>>testCloseTo (in category 'testing compare') ----- testCloseTo self deny: (Float nan closeTo: Float nan) description: 'NaN isn''t close to anything'. self deny: (Float nan closeTo: 1.0) description: 'NaN isn''t close to anything'. self deny: (1.0 closeTo: Float nan) description: 'NaN isn''t close to anything'. self deny: (-1.0 closeTo: 1.0). self deny: (1.0 closeTo: Float infinity). self assert: (Float infinity closeTo: Float infinity) description: 'since they are =, they also are closeTo:'. self assert: (1.0/3.0 closeTo: 1/3). self assert: (1.0e-8 closeTo: 0). self assert: (0 closeTo: 1.0e-8). self assert: (1+1.0e-8 closeTo: 1.0). self assert: (1000000001.0 closeTo: 1000000000.0). self deny: (1000000001 closeTo: 1000000000) description: 'exact representation are considered closeTo: only if equal'.! Item was changed: + ----- Method: FloatTest>>testComparison (in category 'tests - compare') ----- - ----- Method: FloatTest>>testComparison (in category 'testing compare') ----- testComparison "test equality when Float conversion loose bits" | a b c | a := 16r1FFFFFFFFFFFFF1. b := 16r1FFFFFFFFFFFFF3. c := a asFloat. self assert: ((a = c) & (b = c)) ==> (a = b). "Test equality when Float conversion exact" self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat. self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat asInteger. "Test inequality when Float conversion loose bits" self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1. self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1.0. self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1. self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1.0. "Test exact vs inexact arithmetic" (1 to: 100) do: [:i | i isPowerOfTwo ifTrue: [self assert: (1/i) = (1/i) asFloat] ifFalse: [self deny: (1/i) = (1/i) asFloat]]. "Test overflow (compare to infinity)" a := (11 raisedTo: 400) / 2. b := (13 raisedTo: 400) / 2. c := a asFloat. self assert: ((a = c) & (b = c)) ==> (a = b). "every integer is smaller than infinity" self assert: a < Float infinity. self assert: a > Float negativeInfinity. "Test underflow" self deny: 1 / (11 raisedTo: 400) = 0. self deny: 1 / (11 raisedTo: 400) = 0.0. "Test hash code" self assert: ((Set new: 3) add: 3; add: 3.0; size) = ((Set new: 4) add: 3; add: 3.0; size).! Item was changed: + ----- Method: FloatTest>>testComparisonWhenPrimitiveFails (in category 'tests - compare') ----- - ----- Method: FloatTest>>testComparisonWhenPrimitiveFails (in category 'testing compare') ----- testComparisonWhenPrimitiveFails "This is related to http://bugs.squeak.org/view.php?id=7361" self deny: 0.5 < (1/4). self deny: 0.5 < (1/2). self assert: 0.5 < (3/4). self deny: 0.5 <= (1/4). self assert: 0.5 <= (1/2). self assert: 0.5 <= (3/4). self assert: 0.5 > (1/4). self deny: 0.5 > (1/2). self deny: 0.5 > (3/4). self assert: 0.5 >= (1/4). self assert: 0.5 >= (1/2). self deny: 0.5 >= (3/4). self deny: 0.5 = (1/4). self assert: 0.5 = (1/2). self deny: 0.5 = (3/4). self assert: 0.5 ~= (1/4). self deny: 0.5 ~= (1/2). self assert: 0.5 ~= (3/4).! Item was changed: + ----- Method: FloatTest>>testContinuedFractions (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testContinuedFractions (in category 'testing - arithmetic') ----- testContinuedFractions self assert: (Float pi asApproximateFractionAtOrder: 1) = (22/7). self assert: (Float pi asApproximateFractionAtOrder: 3) = (355/113)! Item was changed: + ----- Method: FloatTest>>testCopy (in category 'tests') ----- - ----- Method: FloatTest>>testCopy (in category 'testing') ----- testCopy "Elementary tests" self assert: 2.0 copy = 2.0. self assert: -0.5 copy = -0.5. "Are exceptional Floats preserved by the copy ?" self assert: Float nan copy isNaN. self assert: Float infinity copy = Float infinity. self assert: Float negativeInfinity copy = Float negativeInfinity. "Is the sign of zero preserved by the copy ?" self assert: 0.0 copy hex = 0.0 hex. self assert: Float negativeZero copy hex = Float negativeZero hex.! Item was changed: + ----- Method: FloatTest>>testCopySign (in category 'tests - zero behavior') ----- - ----- Method: FloatTest>>testCopySign (in category 'zero behavior') ----- testCopySign self assert: (0.0 copySignTo: 1) = 1. self assert: (Float negativeZero copySignTo: 1) = -1. self assertIsNegativeZero: (-1 copySignTo: 0.0). self assertIsPositiveZero: (1 copySignTo: Float negativeZero).! Item was changed: + ----- Method: FloatTest>>testDivide (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testDivide (in category 'testing - arithmetic') ----- testDivide self assert: 1.5 / 2.0 = 0.75. self assert: 2.0 / 1 = 2.0. self should: [ 2.0 / 0 ] raise: ZeroDivide. self should: [ 2.0 / 0.0 ] raise: ZeroDivide. self should: [ 1.2 / Float negativeZero ] raise: ZeroDivide. self should: [ 1.2 / (1.3 - 1.3) ] raise: ZeroDivide ! Item was changed: + ----- Method: FloatTest>>testFloatRounded (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFloatRounded (in category 'testing - conversion') ----- testFloatRounded "5000000000000001 asFloat has an exact representation (no round off error). It should round to nearest integer without loosing bits. This is a no regression test on http://bugs.squeak.org/view.php?id=7134" | x y int r | "This is a preamble asserting exactness of representation and quality of various conversions" int := 5000000000000001. x := int asFloat. y := (5 asFloat squared squared squared squared timesTwoPower: 15) + 1. self assert: x = y. self assert: x asTrueFraction = int. "this one should be true for any float in order to conform to ISO/IEC 10967-2" self assert: x rounded = x asTrueFraction rounded. self assert: x negated rounded = x negated asTrueFraction rounded. "a random test" r := Random new. 10000 timesRepeat: [ x := r next * 1.9999e16 + 1.0e12 . self assert: x rounded = x asTrueFraction rounded. self assert: x negated rounded = x negated asTrueFraction rounded]! Item was changed: + ----- Method: FloatTest>>testFloatTruncated (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFloatTruncated (in category 'testing - conversion') ----- testFloatTruncated "(10 raisedTo: 16) asFloat has an exact representation (no round off error). It should convert back to integer without loosing bits. This is a no regression test on http://bugs.impara.de/view.php?id=3504" | x y int r | int := 10 raisedTo: 16. x := int asFloat. y := (5 raisedTo: 16) asFloat timesTwoPower: 16. self assert: x = y. self assert: x asInteger = int. "this one should be true for any float" self assert: x asInteger = x asTrueFraction asInteger. "a random test" r := Random new. 10000 timesRepeat: [ x := r next * 1.9999e16 + 1.0e12 . self assert: x truncated = x asTrueFraction truncated]. "test an edge case (see https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/376)" self assert: SmallInteger maxVal + 1 equals: (SmallInteger maxVal + 1) asFloat asInteger! Item was changed: + ----- Method: FloatTest>>testFloor (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFloor (in category 'testing - conversion') ----- testFloor self assert: 1.0 floor = 1. self assert: 1.1 floor = 1. self assert: -2.0 floor = -2. self assert: -2.1 floor = -3.! Item was changed: + ----- Method: FloatTest>>testFractionAsExactFloat (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFractionAsExactFloat (in category 'testing - conversion') ----- testFractionAsExactFloat { 1/2. 1<<Float precision - 1 / (1 << 8). Float fminNormalized asFraction. Float fmin asFraction * 3. Float fmin asFraction. } do: [:f | self assert: f asExactFloat equals: f asFloat]! Item was changed: + ----- Method: FloatTest>>testFractionAsFloat (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFractionAsFloat (in category 'testing - conversion') ----- testFractionAsFloat "use a random test" | r m frac err collec | r := Random new seed: 1234567. m := (2 raisedTo: 54) - 1. 200 timesRepeat: [ frac := ((r nextInt: m) * (r nextInt: m) + 1) / ((r nextInt: m) * (r nextInt: m) + 1). err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). self assert: err < (1/2)]. collec := #(16r10000000000000 16r1FFFFFFFFFFFFF 1 2 16r20000000000000 16r20000000000001 16r3FFFFFFFFFFFFF 16r3FFFFFFFFFFFFE 16r3FFFFFFFFFFFFD). collec do: [:num | collec do: [:den | frac := Fraction numerator: num denominator: den. err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). self assert: err <= (1/2)]].! Item was changed: + ----- Method: FloatTest>>testFractionAsFloat2 (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFractionAsFloat2 (in category 'testing - conversion') ----- testFractionAsFloat2 "test rounding to nearest even" self assert: ((1<<52)+0+(1/4)) asFloat asTrueFraction = ((1<<52)+0). self assert: ((1<<52)+0+(1/2)) asFloat asTrueFraction = ((1<<52)+0). self assert: ((1<<52)+0+(3/4)) asFloat asTrueFraction = ((1<<52)+1). self assert: ((1<<52)+1+(1/4)) asFloat asTrueFraction = ((1<<52)+1). self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2). self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).! Item was changed: + ----- Method: FloatTest>>testFractionAsFloatWithUnderflow (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFractionAsFloatWithUnderflow (in category 'testing - conversion') ----- testFractionAsFloatWithUnderflow "test rounding to nearest even" | underflowPower | underflowPower := Float emin - Float precision. self assert: (2 raisedTo: underflowPower) asFloat = 0.0. self assert: (2 raisedTo: underflowPower) negated asFloat = 0.0. self assert: (2 raisedTo: underflowPower) negated asFloat signBit = 1 description: 'a negative underflow should return a negative zero'.! Item was changed: + ----- Method: FloatTest>>testFractionIsAnExactFloat (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testFractionIsAnExactFloat (in category 'testing - conversion') ----- testFractionIsAnExactFloat self assert: (1/2) isAnExactFloat. self assert: (1<<Float precision - 1 / (1 << 8)) isAnExactFloat. self assert: (Float fmin asFraction * 3) isAnExactFloat. self assert: Float fmin asFraction isAnExactFloat. self deny: (Float fmin asFraction / 2) isAnExactFloat. self deny: (Float fmin asFraction * 3 / 2) isAnExactFloat. self deny: (1 / 3) isAnExactFloat. self deny: (1<<Float precision + 1 / 2) isAnExactFloat.! Item was changed: + ----- Method: FloatTest>>testHugeIntegerCloseTo (in category 'tests - infinity behavior') ----- - ----- Method: FloatTest>>testHugeIntegerCloseTo (in category 'infinity behavior') ----- testHugeIntegerCloseTo "This is a test for bug http://bugs.squeak.org/view.php?id=7368" "FloatTest new testHugeIntegerCloseTo" self deny: (1.0 closeTo: 200 factorial). self deny: (200 factorial closeTo: 1.0). self assert: (Float infinity closeTo: 200 factorial) = (200 factorial closeTo: Float infinity).! Item was changed: + ----- Method: FloatTest>>testInfinity1 (in category 'tests - infinity behavior') ----- - ----- Method: FloatTest>>testInfinity1 (in category 'infinity behavior') ----- testInfinity1 "FloatTest new testInfinity1" | i1 i2 | i1 := 10000 exp. i2 := 1000000000 exp. self assert: i1 isInfinite & i2 isInfinite & (i1 = i2). "All infinities are equal. (This is a very substantial difference to NaN's, which are never equal." ! Item was changed: + ----- Method: FloatTest>>testInfinity2 (in category 'tests - infinity behavior') ----- - ----- Method: FloatTest>>testInfinity2 (in category 'infinity behavior') ----- testInfinity2 "FloatTest new testInfinity2" | i1 i2 | i1 := 10000 exp. i2 := 1000000000 exp. i2 := 0 - i2. " this is entirely ok. You can compute with infinite values." self assert: i1 isInfinite & i2 isInfinite & i1 positive & i2 negative. self deny: i1 = i2. "All infinities are signed. Negative infinity is not equal to Infinity" ! Item was changed: + ----- Method: FloatTest>>testInfinity3 (in category 'tests - IEEE 754') ----- - ----- Method: FloatTest>>testInfinity3 (in category 'IEEE 754') ----- testInfinity3 self assert: (Float negativeInfinity asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '11111111100000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '11111111100000000000000000000000' readStream base: 2)) = Float negativeInfinity! Item was changed: + ----- Method: FloatTest>>testInfinityCloseTo (in category 'tests - infinity behavior') ----- - ----- Method: FloatTest>>testInfinityCloseTo (in category 'infinity behavior') ----- testInfinityCloseTo "This is a test for bug http://bugs.squeak.org/view.php?id=6729:" "FloatTest new testInfinityCloseTo" self deny: (Float infinity closeTo: Float negativeInfinity). self deny: (Float negativeInfinity closeTo: Float infinity).! Item was changed: + ----- Method: FloatTest>>testIntegerAsFloat (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testIntegerAsFloat (in category 'testing - conversion') ----- testIntegerAsFloat "assert IEEE 754 round to nearest even mode is honoured" self deny: 16r1FFFFFFFFFFFF0801 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 65 bits" self deny: 16r1FFFFFFFFFFFF0802 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 64 bits" self assert: 16r1FFFFFFFFFFF1F800 asFloat = 16r1FFFFFFFFFFF20000 asFloat. "nearest even is upper" self assert: 16r1FFFFFFFFFFFF0800 asFloat = 16r1FFFFFFFFFFFF0000 asFloat. "nearest even is lower" ! Item was changed: + ----- Method: FloatTest>>testIsZero (in category 'tests - zero behavior') ----- - ----- Method: FloatTest>>testIsZero (in category 'zero behavior') ----- testIsZero self assert: 0.0 isZero. self deny: 0.1 isZero.! Item was changed: + ----- Method: FloatTest>>testLargeIntegerIsAnExactFloat (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testLargeIntegerIsAnExactFloat (in category 'testing - conversion') ----- testLargeIntegerIsAnExactFloat self assert: Float fmax asInteger isAnExactFloat. self deny: (Float fmax asInteger + (Float fmax ulp / 2) asInteger) isAnExactFloat. self deny: (Float fmax asInteger * 2) isAnExactFloat! Item was changed: + ----- Method: FloatTest>>testLiteralEqualityOfNan (in category 'tests - compare') ----- - ----- Method: FloatTest>>testLiteralEqualityOfNan (in category 'testing compare') ----- testLiteralEqualityOfNan | nan | nan := Float nan. self assert: (nan literalEqual: nan) description: 'Float nan is not equal to itself, though it is literally equal'.! Item was changed: + ----- Method: FloatTest>>testLiteralEqualityOfZeroAndNegativeZero (in category 'tests - compare') ----- - ----- Method: FloatTest>>testLiteralEqualityOfZeroAndNegativeZero (in category 'testing compare') ----- testLiteralEqualityOfZeroAndNegativeZero self assert: 1 equals: (Compiler evaluate: '1>2 ifTrue: [0.0] ifFalse: [-0.0]') signBit description: 'Float zero and negativeZero are not literally substituable'.! Item was changed: + ----- Method: FloatTest>>testMaxExactInteger (in category 'tests') ----- - ----- Method: FloatTest>>testMaxExactInteger (in category 'testing') ----- testMaxExactInteger " FloatTest new testMaxExactInteger " self assert: Float maxExactInteger asFloat truncated = Float maxExactInteger. 0 to: 10000 do: [ :j | self assert: (Float maxExactInteger-j) asFloat truncated = (Float maxExactInteger-j) ]. self deny: (Float maxExactInteger+1) asFloat truncated = (Float maxExactInteger+1) ! Item was changed: + ----- Method: FloatTest>>testNaN1 (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaN1 (in category 'NaN behavior') ----- testNaN1 "FloatTest new testNaN1" self assert: Float nan == Float nan. self deny: Float nan = Float nan. "a NaN is not equal to itself." ! Item was changed: + ----- Method: FloatTest>>testNaN2 (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaN2 (in category 'NaN behavior') ----- testNaN2 "Two NaN values are always considered to be different. On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing the bit pattern of the first word of a NaN produces another value that is still considered equal to NaN. This test should work on both little endian and big endian machines. However, it is not guaranteed to work on future 64 bit versions of Squeak, for which Float may have different internal representations." "FloatTest new testNaN2" | nan1 nan2 | nan1 := Float nan copy. nan2 := Float nan copy. "test two instances of NaN with the same bit pattern" self deny: nan1 = nan2. self deny: nan1 == nan2. self deny: nan1 = nan1. self assert: nan1 == nan1. "change the bit pattern of nan1" self assert: nan1 size = 2. self assert: (nan1 at: 2) = 0. nan1 at: 1 put: (nan1 at: 1) + 999. self assert: nan1 isNaN. self assert: nan2 isNaN. self deny: (nan1 at: 1) = (nan2 at: 1). "test two instances of NaN with different bit patterns" self deny: nan1 = nan2. self deny: nan1 == nan2. self deny: nan1 = nan1. self assert: nan1 == nan1 ! Item was changed: + ----- Method: FloatTest>>testNaN3 (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaN3 (in category 'NaN behavior') ----- testNaN3 "FloatTest new testNaN3" | set item identitySet | set := Set new. set add: (item := Float nan). self deny: (set includes: item). identitySet := IdentitySet new. identitySet add: (item := Float nan). self assert: (identitySet includes: item). "as a NaN is not equal to itself, it can not be retrieved from a set" ! Item was changed: + ----- Method: FloatTest>>testNaN4 (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaN4 (in category 'NaN behavior') ----- testNaN4 "FloatTest new testNaN4" | dict | dict := Dictionary new. dict at: Float nan put: #NaN. self deny: (dict includes: Float nan). "as a NaN is not equal to itself, it can not be retrieved when it is used as a dictionary key" ! Item was changed: + ----- Method: FloatTest>>testNaN5 (in category 'tests - IEEE 754') ----- - ----- Method: FloatTest>>testNaN5 (in category 'IEEE 754') ----- testNaN5 | nanstr | "check the NaN string representation conforms to IEEE 754" nanstr := Float nan asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2. self assert: (#($0 $1) includes: (nanstr at: 1)); assert: (nanstr copyFrom: 2 to: 9) = '11111111'; assert: (#($0 $1) includes: (nanstr at: 10)); "accept both quiet and signalled NaNs" assert: ((nanstr copyFrom: 11 to: 32) reject: [ :c | #($0 $1) includes: c ]) isEmpty. "check a correct quiet NaN is created from a string" self assert: (Float fromIEEE32Bit: (Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN! Item was changed: + ----- Method: FloatTest>>testNaNCompare (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaNCompare (in category 'NaN behavior') ----- testNaNCompare "IEEE 754 states that NaN cannot be ordered. As a consequence, every arithmetic comparison involving a NaN SHOULD return false. Except the is different test (~=). This test does verify this rule" | compareSelectors theNaN anotherNaN comparand brokenMethods warningMessage | compareSelectors := #(#< #<= #> #>= #=). theNaN := Float nan. anotherNaN := Float infinity - Float infinity. comparand := {1. 2.3. Float infinity. 2/3. 1.25s2. 2 raisedTo: 50}. comparand := comparand , (comparand collect: [:e | e negated]). comparand := comparand , {theNaN. anotherNaN}. "do a first pass to collect all broken methods" brokenMethods := Set new. comparand do: [:comp | compareSelectors do: [:op | (theNaN perform: op with: comp) ifTrue: [brokenMethods add: (theNaN class lookupSelector: op)]. (comp perform: op with: theNaN) ifTrue: [brokenMethods add: (comp class lookupSelector: op)]]. (theNaN ~= comp) ifFalse: [brokenMethods add: (theNaN class lookupSelector: #~=)]. (comp ~= theNaN) ifFalse: [brokenMethods add: (comp class lookupSelector: #~=)]]. "build a warning message to tell about all broken methods at once" warningMessage := String streamContents: [:s | s nextPutAll: 'According to IEEE 754 comparing with a NaN should always return false, except ~= that should return true.'; cr. s nextPutAll: 'All these methods failed to do so. They are either broken or call a broken one'. brokenMethods do: [:e | s cr; print: e methodClass; nextPutAll: '>>'; print: e selector]]. "Redo the tests so as to eventually open a debugger on one of the failures" brokenMethods := Set new. comparand do: [:comp2 | compareSelectors do: [:op2 | self deny: (theNaN perform: op2 with: comp2) description: warningMessage. self deny: (comp2 perform: op2 with: theNaN) description: warningMessage]. self assert: (theNaN ~= comp2) description: warningMessage. self assert: (comp2 ~= theNaN) description: warningMessage].! Item was changed: + ----- Method: FloatTest>>testNaNisLiteral (in category 'tests - NaN behavior') ----- - ----- Method: FloatTest>>testNaNisLiteral (in category 'NaN behavior') ----- testNaNisLiteral self deny: Float nan isLiteral description: 'there is no literal representation of NaN'! Item was changed: + ----- Method: FloatTest>>testNegativeZeroAbs (in category 'tests - zero behavior') ----- - ----- Method: FloatTest>>testNegativeZeroAbs (in category 'zero behavior') ----- testNegativeZeroAbs self assert: Float negativeZero abs signBit = 0 description: 'the absolute value of a negative zero is zero'! Item was changed: + ----- Method: FloatTest>>testNegativeZeroSign (in category 'tests - zero behavior') ----- - ----- Method: FloatTest>>testNegativeZeroSign (in category 'zero behavior') ----- testNegativeZeroSign self assert: Float negativeZero sign = 0. self assert: Float negativeZero signBit = 1 "That's how we can distinguish from positive zero"! Item was changed: + ----- Method: FloatTest>>testPrintPaddedWithTo (in category 'tests - printing') ----- - ----- Method: FloatTest>>testPrintPaddedWithTo (in category 'printing') ----- testPrintPaddedWithTo "This bug was reported in http://lists.gforge.inria.fr/pipermail/pharo-users/2011-February/001569.html. The problem was caused by treating the format specifier as a number rather than as a string, such the the number may be a Float subject to floating point rounding errors. The solution to treat the format specifier as a string, and extract the integer fields before and after the decimal point in the string." self assert: [(1.0 printPaddedWith: $0 to: 2.2) = '01.00']. self assert: [(1.0 printPaddedWith: $X to: 2.2) = 'X1.0X']. self assert: [(1.0 printPaddedWith: $0 to: 2) = '01.0']. self assert: [(12345.6789 printPaddedWith: $0 to: 2) = '12345.6789']. self assert: [(12345.6789 printPaddedWith: $0 to: 2.2) = '12345.6789']. self assert: [(12.34 printPaddedWith: $0 to: 2.2) = '12.34']. self assert: [(12345.6789 printPaddedWith: $0 to: 2.2) = '12345.6789']. self assert: [(123.456 printPaddedWith: $X to: 4.4) = 'X123.456X']. self assert: [(1.0 printPaddedWith: $0 to: 2.1) = '01.0']. self assert: [(1.0 printPaddedWith: $0 to: 2.2) = '01.00']. self assert: [(1.0 printPaddedWith: $0 to: 2.3) = '01.000']. "previously failed due to float usage" self assert: [(1.0 printPaddedWith: $0 to: 2.4) = '01.0000']. "previously failed due to float usage" self assert: [(1.0 printPaddedWith: $0 to: 2.5) = '01.00000'] ! Item was changed: + ----- Method: FloatTest>>testReadFromManyDigits (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testReadFromManyDigits (in category 'testing - conversion') ----- testReadFromManyDigits "A naive algorithm may interpret these representations as Infinity or NaN. This is http://bugs.squeak.org/view.php?id=6982" | s1 s2 | s1 := '1' , (String new: 321 withAll: $0) , '.0e-321'. s2 := '0.' , (String new: 320 withAll: $0) , '1e321'. self assert: (Number readFrom: s1) = 1. self assert: (Number readFrom: s2) = 1.! Item was changed: + ----- Method: FloatTest>>testReciprocal (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testReciprocal (in category 'testing - arithmetic') ----- testReciprocal self assert: 1.0 reciprocal = 1.0; assert: 2.0 reciprocal = 0.5; assert: -1.0 reciprocal = -1.0; assert: -2.0 reciprocal = -0.5. self should: [ 0.0 reciprocal ] raise: ZeroDivide! Item was changed: + ----- Method: FloatTest>>testRounded (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testRounded (in category 'testing - conversion') ----- testRounded self assert: 0.9 rounded = 1. self assert: 1.0 rounded = 1. self assert: 1.1 rounded = 1. self assert: -1.9 rounded = -2. self assert: -2.0 rounded = -2. self assert: -2.1 rounded = -2. "In case of tie, round to upper magnitude" self assert: 1.5 rounded = 2. self assert: -1.5 rounded = -2.! Item was changed: + ----- Method: FloatTest>>testSetOfFloat (in category 'tests') ----- - ----- Method: FloatTest>>testSetOfFloat (in category 'testing') ----- testSetOfFloat "Classical disagreement between hash and = did lead to a bug. This is a non regression test from http://bugs.squeak.org/view.php?id=3360" | size3 size4 | size3 := (Set new: 3) add: 3; add: 3.0; size. size4 := (Set new: 4) add: 3; add: 3.0; size. self assert: size3 = size4 description: 'The size of a Set should not depend on its capacity.'! Item was changed: + ----- Method: FloatTest>>testSign (in category 'tests') ----- - ----- Method: FloatTest>>testSign (in category 'testing') ----- testSign "Set up" | negatives negz positives strictNegatives strictPositives zero | strictPositives := {2. 2.5. Float infinity}. strictNegatives := {-3. -3.25. Float negativeInfinity}. zero := 0.0. negz := Float negativeZero. positives := strictPositives copyWith: zero. negatives := strictNegatives copyWith: negz. "The sign of non zeros" strictPositives do: [:aPositive | self assert: aPositive sign = 1]. strictNegatives do: [:aNegative | self assert: aNegative sign = -1]. "The sign of zeros" self assert: zero sign = 0. self assert: negz sign = 0. "remark that negz can't be distinguished from zero and is thus considered positive..." self assert: negz signBit = 1. "but we can differentiate" "Test the copy sign functions" positives do: [:aPositiveSign | positives do: [:aPositive | self assert: (aPositive sign: aPositiveSign) = aPositive]. negatives do: [:aNegative | self assert: (aNegative sign: aPositiveSign) = aNegative negated]. (zero sign: aPositiveSign) signBit = 0. (negz sign: aPositiveSign) signBit = 0]. negatives do: [:aNegativeSign | positives do: [:aPositive | self assert: (aPositive sign: aNegativeSign) = aPositive negated]. negatives do: [:aNegative | self assert: (aNegative sign: aNegativeSign) = aNegative]. (zero sign: aNegativeSign) signBit = 1. (negz sign: aNegativeSign) signBit = 1].! Item was changed: + ----- Method: FloatTest>>testSignificandAndExponent (in category 'tests - characterization') ----- - ----- Method: FloatTest>>testSignificandAndExponent (in category 'characterization') ----- testSignificandAndExponent | denormals exceptionals normals | normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. normals , denormals , exceptionals do: [:aFloat | "Any Float can be decomposed into its significand and exponent, and the significand holds the sign" aFloat isNaN ifTrue: [self assert: (aFloat significand timesTwoPower: aFloat exponent) isNaN] ifFalse: [self assert: (aFloat significand timesTwoPower: aFloat exponent) equals: aFloat]]. normals , denormals do: [:aFloat | "The significand magnitude is in interval [1.0,2.0( " aFloat = 0.0 ifTrue: [self assert: aFloat significand equals: 0] ifFalse: [self assert: aFloat significand abs >= 1.0; assert: aFloat significand abs < 2.0]]! Item was changed: + ----- Method: FloatTest>>testSignificandAsInteger (in category 'tests - characterization') ----- - ----- Method: FloatTest>>testSignificandAsInteger (in category 'characterization') ----- testSignificandAsInteger | mantissaBits denormalPowersOfTwo denormals exceptionals normalPowersOfTwo normals | "There are 52 bits used for representing the mantissa (plus an eventual leading 1, see below)" mantissaBits := Float precision - 1. normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. normalPowersOfTwo := (-10 to: 10) collect: [:i | 1.0 timesTwoPower: i]. denormalPowersOfTwo := (Float emin - mantissaBits to: Float emin - 1) collect: [:i | 1.0 timesTwoPower: i]. normals do: [:aNormalFloat | "Assume the mantissa is written in least 52 bits of hex format, with an implied 1 on position 53" self assert: (((Integer readFrom: aNormalFloat hex base: 16) bitAnd: 1<<mantissaBits-1) bitOr: 1<<mantissaBits) equals: aNormalFloat significandAsInteger]. denormals , exceptionals do: [:aDenormalOrExceptionalFloat | "For every other Float, zero, denormal or exceptional, no implied leading one" self assert: ((Integer readFrom: aDenormalOrExceptionalFloat hex base: 16) bitAnd: 1<<mantissaBits-1) equals: aDenormalOrExceptionalFloat significandAsInteger]. normalPowersOfTwo do: [:aNormalPowerOfTwoFloat | "The significand of a power of two is a power of two, with high bit of expected precision" self assert: aNormalPowerOfTwoFloat significandAsInteger isPowerOfTwo. self assert: aNormalPowerOfTwoFloat significandAsInteger highBit equals: Float precision. self assert: aNormalPowerOfTwoFloat successor significandAsInteger equals: aNormalPowerOfTwoFloat significandAsInteger + 1. "The last one is not true for fminNormalized" aNormalPowerOfTwoFloat = Float fminNormalized or: [ self assert: aNormalPowerOfTwoFloat predecessor significandAsInteger equals: aNormalPowerOfTwoFloat significandAsInteger * 2 - 1]]. denormalPowersOfTwo do: [:aDenormalPowerOfTwoFloat | "The significand of a denormal power of two is a power of two, just with less bits" self assert: aDenormalPowerOfTwoFloat significandAsInteger isPowerOfTwo. self assert: aDenormalPowerOfTwoFloat significandAsInteger highBit equals: Float precision + aDenormalPowerOfTwoFloat exponent - Float emin. aDenormalPowerOfTwoFloat successor = Float fminNormalized or: [ self assert: aDenormalPowerOfTwoFloat successor significandAsInteger equals: aDenormalPowerOfTwoFloat significandAsInteger + 1]. self assert: aDenormalPowerOfTwoFloat predecessor significandAsInteger equals: aDenormalPowerOfTwoFloat significandAsInteger - 1.]. "Well known value for a few extremal cases" self assert: Float fmax significandAsInteger equals: 1 << Float precision - 1. self assert: Float fmin significandAsInteger equals: 1. self assert: 0.0 significandAsInteger equals: 0. self assert: Float infinity significandAsInteger equals: 0. self assert: Float nan significandAsInteger > 0! Item was changed: + ----- Method: FloatTest>>testStoreBase16 (in category 'tests - printing') ----- - ----- Method: FloatTest>>testStoreBase16 (in category 'printing') ----- testStoreBase16 "This bug was reported in mantis http://bugs.squeak.org/view.php?id=6695" self assert: (20.0 storeStringBase: 16) = '16r14.0' description: 'the radix prefix should not be omitted, except in base 10'! Item was changed: + ----- Method: FloatTest>>testStoreOn (in category 'tests') ----- - ----- Method: FloatTest>>testStoreOn (in category 'testing') ----- testStoreOn "If storeOn: prints exactly and the parser avoid cumulating round off Errors, then Float should be read back exactly. Note: there is no guarantee to restore the bit pattern of NaN though" self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. self assert: (Compiler evaluate: Float nan storeString) isNaN.! Item was changed: + ----- Method: FloatTest>>testStringAsNumber (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testStringAsNumber (in category 'testing - conversion') ----- testStringAsNumber "This covers parsing in Number>>readFrom:" | aFloat | aFloat := '10r-12.3456' asNumber. self assert: -12.3456 = aFloat. aFloat := '10r-12.3456e2' asNumber. self assert: -1234.56 = aFloat. aFloat := '10r-12.3456d2' asNumber. self assert: -1234.56 = aFloat. aFloat := '10r-12.3456q2' asNumber. self assert: -1234.56 = aFloat. aFloat := '-12.3456q2' asNumber. self assert: -1234.56 = aFloat. aFloat := '12.3456q2' asNumber. self assert: 1234.56 = aFloat. self should: [ 'invalid number' asNumber ] raise: NumberParserError! Item was changed: + ----- Method: FloatTest>>testTimesTwoPowerGradualUnderflow (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testTimesTwoPowerGradualUnderflow (in category 'testing - arithmetic') ----- testTimesTwoPowerGradualUnderflow "Here is a vicious case where timesTwoPower is inexact because it underflows. And two consecutive inexact operations lead to a different result than a single one. Typically expressed as multiple of Float fmin in base 2, 2r1011*Float fmin shifted by -3 with round to nearest, tie to even mode: -> round(1.011) -> 1.0 = fmin But if first shifted by -2 then by -1: -> round(10.11) -> 11.0 = 3*fmin -> round(1.1) -> 10.0 = 2*fmin Or first shifted by -1 then by -2: -> round(101.1) -> 110.0 = 6*fmin -> round(1.1) -> 10.0 = 2*fmin A naive implementation that split the shift uncarefully might fail to handle such case correctly." | f | f := 2r1011 asFloat. "scan the whole range of possible exponents for this significand" Float fmin exponent + f exponent to: Float fmax exponent - f exponent do: [:exp | | g | g := f timesTwoPower: exp. self assert: (g timesTwoPower: Float fmin exponent - g exponent) = Float fmin].! Item was changed: + ----- Method: FloatTest>>testTimesTwoPowerOverflow (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testTimesTwoPowerOverflow (in category 'testing - arithmetic') ----- testTimesTwoPowerOverflow self assert: (Float fminNormalized timesTwoPower: Float emax - Float emin) equals: (2.0 raisedTo: Float emax). self assert: (Float zero timesTwoPower: SmallInteger maxVal squared) equals: Float zero. ! Item was changed: + ----- Method: FloatTest>>testTimesTwoPowerUnderflow (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testTimesTwoPowerUnderflow (in category 'testing - arithmetic') ----- testTimesTwoPowerUnderflow self assert: ((2.0 raisedTo: Float emax) timesTwoPower: Float emin - Float emax) equals: Float fminNormalized. self assert: (Float infinity timesTwoPower: SmallInteger minVal * SmallInteger maxVal) equals: Float infinity. ! Item was changed: + ----- Method: FloatTest>>testTruncated (in category 'tests - conversion') ----- - ----- Method: FloatTest>>testTruncated (in category 'testing - conversion') ----- testTruncated self assert: 1.0 truncated = 1. self assert: 1.1 truncated = 1. self assert: -2.0 truncated = -2. self assert: -2.1 truncated = -2.! Item was changed: + ----- Method: FloatTest>>testUlp (in category 'tests - characterization') ----- - ----- Method: FloatTest>>testUlp (in category 'characterization') ----- testUlp {Float pi predecessor. Float pi. Float pi successor} do: [:f | self assert: (f * 2) ulp = (f ulp * 2). self assert: (f / 2) ulp = (f ulp / 2). self deny: f + f ulp = f. self deny: f - f ulp = f. "Tests below are valid as long as default rounding mode (to nearest even) is used" self assert: f significandAsInteger odd ==> (f ulp / 2.0 + f = f successor). self assert: f significandAsInteger even ==> (f ulp / 2.0 + f = f)]. self assert: 0.0 ulp = Float fmin. self assert: 1.0 ulp = Float epsilon. self assert: Float nan ulp isNaN. self assert: Float infinity ulp = Float infinity. self assert: Float negativeInfinity ulp = Float infinity. self assert: ((0 to: Float precision - 1) allSatisfy: [:each | (Float fmin timesTwoPower: each) ulp = Float fmin]). ! Item was changed: + ----- Method: FloatTest>>testZero1 (in category 'tests - zero behavior') ----- - ----- Method: FloatTest>>testZero1 (in category 'zero behavior') ----- testZero1 "FloatTest new testZero1" self assert: Float negativeZero = 0 asFloat. self assert: (Float negativeZero at: 1) ~= (0 asFloat at: 1). "The negative zero has a bit representation that is different from the bit representation of the positive zero. Nevertheless, both values are defined to be equal." ! Item was changed: + ----- Method: FloatTest>>testZero2 (in category 'tests - IEEE 754') ----- - ----- Method: FloatTest>>testZero2 (in category 'IEEE 754') ----- testZero2 self assert: (Float negativeZero asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '10000000000000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '10000000000000000000000000000000' readStream base: 2)) = Float negativeZero! Item was changed: + ----- Method: FloatTest>>testZeroRaisedToNegativePower (in category 'tests - arithmetic') ----- - ----- Method: FloatTest>>testZeroRaisedToNegativePower (in category 'testing - arithmetic') ----- testZeroRaisedToNegativePower "this is a test related to http://bugs.squeak.org/view.php?id=6781" self should: [0.0 raisedTo: -1] raise: ZeroDivide. self should: [0.0 raisedTo: -1.0] raise: ZeroDivide.! Item was changed: + ----- Method: IntegerTest>>testCrossSumBase (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testCrossSumBase (in category 'testing - arithmetic') ----- testCrossSumBase "self run: #testCrossSumBase" self assert: ( ((-20 to: 20) collect: [:each | each crossSumBase: 10]) asArray = #(2 10 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 10 2)). self assert: ( ((-20 to: 20) collect: [:each | each crossSumBase: 2]) asArray = #(2 3 2 2 1 4 3 3 2 3 2 2 1 3 2 2 1 2 1 1 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2)). self should: [10 crossSumBase: 1] raise: AssertionFailure! Item was changed: + ----- Method: IntegerTest>>testIntegerDivision (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testIntegerDivision (in category 'testing - arithmetic') ----- testIntegerDivision | suite | suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). suite := suite , (suite collect: [:e | e negated]). suite do: [:a | suite do: [:b | | q r | q := a // b. r := a \\ b. self assert: b * q + r = a. self assert: r abs < b abs. self assert: (r isZero or: [b negative = r negative])]].! Item was changed: + ----- Method: IntegerTest>>testMontgomeryMultiplication (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testMontgomeryMultiplication (in category 'testing - arithmetic') ----- testMontgomeryMultiplication | a m mInv | m := 15485863. mInv := m montgomeryDigitBase - ((m bitAnd: m montgomeryDigitMax) reciprocalModulo: m montgomeryDigitBase). a := (m montgomeryDigitBase raisedTo: m montgomeryNumberOfDigits) \\ m. #(483933 3871465 8951195) do: [:s | (s montgomeryTimes: a modulo: m mInvModB: mInv) ifNotNil: [:s1 | | s2 sa ssa | self assert: s = s1. sa := s montgomeryTimes: (a * a \\ m) modulo: m mInvModB: mInv. self assert: sa = (s * a \\ m). ssa := sa montgomeryTimes: sa modulo: m mInvModB: mInv. self assert: ssa = (s * s * a \\ m). s2 := ssa montgomeryTimes: 1 modulo: m mInvModB: mInv. self assert: s2 = (s * s \\ m)]].! Item was changed: + ----- Method: IntegerTest>>testQuoRem (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testQuoRem (in category 'testing - arithmetic') ----- testQuoRem | suite | suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). suite := suite , (suite collect: [:e | e negated]). suite do: [:a | suite do: [:b | | q r | q := a quo: b. r := a rem: b. self assert: b * q + r = a. self assert: r abs < b abs. self assert: (r isZero or: [a negative = r negative])]].! Item was changed: + ----- Method: IntegerTest>>testRaisedToModulo (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testRaisedToModulo (in category 'testing - arithmetic') ----- testRaisedToModulo #(301 2047) do: [:m | 1 to: m - 1 by: (m // 30) do: [:x | 11 to: m - 1 by: (m // 40) do: [:y | self assert: (x raisedTo: y) \\ m = (x raisedTo: y modulo: m)]]]. self assert: (8951195 raisedTo: 7742931 modulo: 15485863) = 15485862.! Item was changed: + ----- Method: IntegerTest>>testReciprocalModulo (in category 'tests - arithmetic') ----- - ----- Method: IntegerTest>>testReciprocalModulo (in category 'testing - arithmetic') ----- testReciprocalModulo 1 to: 512 do: [:a | a + 1 to: 512 do: [:b | | c | (a gcd: b) = 1 ifTrue: [c := a reciprocalModulo: b. self assert: (a * c) \\ b = 1] ifFalse: [self should: [ a reciprocalModulo: b ] raise: Error]]].! Item was changed: + ----- Method: MessageSendTest>>testNumArgs (in category 'tests') ----- - ----- Method: MessageSendTest>>testNumArgs (in category 'as yet unclassified') ----- testNumArgs self assert: (MessageSend receiver: Dictionary new selector: #at:put:) numArgs = 2 ; assert: (MessageSend receiver: 3 selector: #sqrt) numArgs = 0! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedFromTo (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedFromTo (in category 'testing-finding') ----- testAllNamedFromTo | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: from: self class to: Object. self assert: pragmasDetected = pragmasCompiled. pragmasDetected := Pragma allNamed: #foo: from: Object to: Object. self assert: pragmasDetected isEmpty.! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedFromToSortedByArgument (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedFromToSortedByArgument (in category 'testing-finding') ----- testAllNamedFromToSortedByArgument | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: from: self class to: Object sortedByArgument: 1. self assert: pragmasDetected = (pragmasCompiled sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedFromToSortedUsing (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedFromToSortedUsing (in category 'testing-finding') ----- testAllNamedFromToSortedUsing | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: from: self class to: Object sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]. self assert: pragmasDetected = (pragmasCompiled sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedIn (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedIn (in category 'testing-finding') ----- testAllNamedIn | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: in: self class. self assert: pragmasDetected = pragmasCompiled. pragmasDetected := Pragma allNamed: #foo: in: Object. self assert: pragmasDetected isEmpty.! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedInSortedByArgument (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedInSortedByArgument (in category 'testing-finding') ----- testAllNamedInSortedByArgument | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: in: self class sortedByArgument: 1. self assert: pragmasDetected = (pragmasCompiled sort: [ :a :b | (a argumentAt: 1) < (b argumentAt: 1) ])! Item was changed: + ----- Method: MethodPragmaTest>>testAllNamedInSortedUsing (in category 'tests-finding') ----- - ----- Method: MethodPragmaTest>>testAllNamedInSortedUsing (in category 'testing-finding') ----- testAllNamedInSortedUsing | pragmasCompiled pragmasDetected | pragmasCompiled := self pragma: #foo: selector: #bar times: 5. pragmasDetected := Pragma allNamed: #foo: in: self class sortedUsing: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]. self assert: pragmasDetected = (pragmasCompiled sort: [ :a :b | (a argumentAt: 1) > (b argumentAt: 1) ]).! Item was changed: + ----- Method: MethodPragmaTest>>testArguments (in category 'tests-pragma') ----- - ----- Method: MethodPragmaTest>>testArguments (in category 'testing-pragma') ----- testArguments | pragma | pragma := Pragma keyword: #foo: arguments: #( 123 ). self assert: pragma arguments = #( 123 ).! Item was changed: + ----- Method: MethodPragmaTest>>testCompileArray (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileArray (in category 'testing-compiler') ----- testCompileArray self assertPragma: 'foo: #()' givesKeyword: #foo: arguments: #( () ). self assertPragma: 'foo: #( foo )' givesKeyword: #foo: arguments: #( ( foo ) ). self assertPragma: 'foo: #( foo: )' givesKeyword: #foo: arguments: #( ( foo: ) ). self assertPragma: 'foo: #( 12 )' givesKeyword: #foo: arguments: #( ( 12 ) ). self assertPragma: 'foo: #( true )' givesKeyword: #foo: arguments: #( ( true ) ). ! Item was changed: + ----- Method: MethodPragmaTest>>testCompileBinary (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileBinary (in category 'testing-compiler') ----- testCompileBinary self assertPragma: ' = 1' givesKeyword: #= arguments: #( 1 ). self assertPragma: ' , 3' givesKeyword: #, arguments: #( 3 ). self assertPragma: ' > 4' givesKeyword: #> arguments: #( 4 ). self assertPragma: ' < 5' givesKeyword: #< arguments: #( 5 ). self assertPragma: ' == 1' givesKeyword: #== arguments: #( 1 ). self assertPragma: ' <> 3' givesKeyword: #<> arguments: #( 3 ). self assertPragma: ' >< 4' givesKeyword: #>< arguments: #( 4 ). self assertPragma: ' ** 5' givesKeyword: #** arguments: #( 5 )! Item was changed: + ----- Method: MethodPragmaTest>>testCompileCharacter (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileCharacter (in category 'testing-compiler') ----- testCompileCharacter self assertPragma: 'foo: $a' givesKeyword: #foo: arguments: #( $a ). self assertPragma: 'foo: $ ' givesKeyword: #foo: arguments: { Character space }.! Item was changed: + ----- Method: MethodPragmaTest>>testCompileEmpty (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileEmpty (in category 'testing-compiler') ----- testCompileEmpty self assertPragma: 'foo' givesKeyword: #foo arguments: #().! Item was changed: + ----- Method: MethodPragmaTest>>testCompileFull (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileFull (in category 'testing-compiler') ----- testCompileFull self assertPragma: 'foo: 1' givesKeyword: #foo: arguments: #( 1 ). self assertPragma: 'foo: 1 bar: 2' givesKeyword: #foo:bar: arguments: #( 1 2 ).! Item was changed: + ----- Method: MethodPragmaTest>>testCompileInvalid (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileInvalid (in category 'testing-compiler') ----- testCompileInvalid "Invalid pragmas should properly raise an error." self should: [ self compile: '<>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<1>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<#123>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo bar>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo 1>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo bar zork>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo bar 1>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo: bar:>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo: #bar: zork:>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<<1>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<=2>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '< =1 = >' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '< =1 =2 >' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo: String>' selector: #zork ] raise: SyntaxErrorNotification. self should: [ self compile: '<foo: Pragma>' selector: #zork ] raise: SyntaxErrorNotification! Item was changed: + ----- Method: MethodPragmaTest>>testCompileNumber (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileNumber (in category 'testing-compiler') ----- testCompileNumber self assertPragma: 'foo: 123' givesKeyword: #foo: arguments: #( 123 ). self assertPragma: 'foo: -123' givesKeyword: #foo: arguments: #( -123 ). self assertPragma: 'foo: 12.3' givesKeyword: #foo: arguments: #( 12.3 ). self assertPragma: 'foo: -12.3' givesKeyword: #foo: arguments: #( -12.3 ).! Item was changed: + ----- Method: MethodPragmaTest>>testCompileString (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileString (in category 'testing-compiler') ----- testCompileString self assertPragma: 'foo: ''''' givesKeyword: #foo: arguments: #( '' ). self assertPragma: 'foo: ''bar''' givesKeyword: #foo: arguments: #( 'bar' ).! Item was changed: + ----- Method: MethodPragmaTest>>testCompileSymbol (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileSymbol (in category 'testing-compiler') ----- testCompileSymbol self assertPragma: 'foo: #bar' givesKeyword: #foo: arguments: #( bar ). self assertPragma: 'foo: #bar:' givesKeyword: #foo: arguments: #( bar: ). self assertPragma: 'foo: #bar:zork:' givesKeyword: #foo: arguments: #( bar:zork: ).! Item was changed: + ----- Method: MethodPragmaTest>>testCompileTemps (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileTemps (in category 'testing-compiler') ----- testCompileTemps "Pragmas should be placeable before and after temps." self shouldnt: [ self assert: (self compile: '| temps | <foo>' selector: #zork) pragmas notEmpty ] raise: SyntaxErrorNotification. self shouldnt: [ self assert: (self compile: '<foo> | temps |' selector: #zork) pragmas notEmpty ] raise: SyntaxErrorNotification.! Item was changed: + ----- Method: MethodPragmaTest>>testCompileValue (in category 'tests-compiler') ----- - ----- Method: MethodPragmaTest>>testCompileValue (in category 'testing-compiler') ----- testCompileValue self assertPragma: 'foo: true' givesKeyword: #foo: arguments: #( true ). self assertPragma: 'foo: false' givesKeyword: #foo: arguments: #( false ). self assertPragma: 'foo: nil' givesKeyword: #foo: arguments: #( nil )! Item was changed: + ----- Method: MethodPragmaTest>>testKeyword (in category 'tests-pragma') ----- - ----- Method: MethodPragmaTest>>testKeyword (in category 'testing-pragma') ----- testKeyword | pragma | pragma := Pragma keyword: #foo: arguments: #( 123 ). self assert: pragma keyword = #foo:.! Item was changed: + ----- Method: MethodPragmaTest>>testMessage (in category 'tests-pragma') ----- - ----- Method: MethodPragmaTest>>testMessage (in category 'testing-pragma') ----- testMessage | pragma message | pragma := Pragma keyword: #foo: arguments: #( 123 ). message := pragma message. self assert: message selector = #foo:. self assert: message arguments = #( 123 ).! Item was changed: + ----- Method: MethodPragmaTest>>testMethod (in category 'tests-method') ----- - ----- Method: MethodPragmaTest>>testMethod (in category 'testing-method') ----- testMethod | pragma | pragma := self pragma: 'foo' selector: #bar. self assert: pragma method == (self class >> #bar).! Item was changed: + ----- Method: MethodPragmaTest>>testMethodClass (in category 'tests-method') ----- - ----- Method: MethodPragmaTest>>testMethodClass (in category 'testing-method') ----- testMethodClass | pragma | pragma := self pragma: 'foo' selector: #bar. self assert: pragma methodClass == self class.! Item was changed: + ----- Method: MethodPragmaTest>>testNoPragma (in category 'tests-compiled') ----- - ----- Method: MethodPragmaTest>>testNoPragma (in category 'testing-compiled') ----- testNoPragma | method | method := self compile: '' selector: #foo. self assert: method pragmas = #().! Item was changed: + ----- Method: MethodPragmaTest>>testPrimitiveIndexed1 (in category 'tests-primitives') ----- - ----- Method: MethodPragmaTest>>testPrimitiveIndexed1 (in category 'testing-primitives') ----- testPrimitiveIndexed1 "This test useses the #instVarAt: primitive." self compile: '<primitive: 74> ^ #inst' selector: #inst. self assert: self inst = #inst.! Item was changed: + ----- Method: MethodPragmaTest>>testPrimitiveIndexed2 (in category 'tests-primitives') ----- - ----- Method: MethodPragmaTest>>testPrimitiveIndexed2 (in category 'testing-primitives') ----- testPrimitiveIndexed2 "This test useses the #asOop primitive." self compile: '<primitive: 75> ^ #oop' selector: #oop. self assert: self oop = self asOop.! Item was changed: + ----- Method: MethodPragmaTest>>testPrimitiveNamed1 (in category 'tests-primitives') ----- - ----- Method: MethodPragmaTest>>testPrimitiveNamed1 (in category 'testing-primitives') ----- testPrimitiveNamed1 "This test useses the #primitiveDirectoryLookup primitive." self compile: '<primitive: ''primitiveDirectoryLookup'' module: ''FilePlugin''> ^ #lookup' selector: #lookup. self assert: self lookup = #lookup. ! Item was changed: + ----- Method: MethodPragmaTest>>testPrimitiveNamed2 (in category 'tests-primitives') ----- - ----- Method: MethodPragmaTest>>testPrimitiveNamed2 (in category 'testing-primitives') ----- testPrimitiveNamed2 "This test useses the #primPathNameDelimiter primitive." self compile: '<primitive: ''primitiveDirectoryDelimitor'' module: ''FilePlugin''> ^ #delim' selector: #delim. self assert: self delim = FileDirectory primPathNameDelimiter. ! Item was changed: + ----- Method: MethodPragmaTest>>testReformat (in category 'tests-printing-reformating') ----- - ----- Method: MethodPragmaTest>>testReformat (in category 'testing-printing-reformating') ----- testReformat self assert: (DisplayScreen class compiledMethodAt: #actualScreenDepth) getSource string = 'actualScreenDepth <primitive: ''primitiveScreenDepth''> ^ Display depth'. self assert: (DisplayScreen class compiledMethodAt: #actualScreenDepth) getSource string = 'actualScreenDepth <primitive: ''primitiveScreenDepth''> ^ Display depth'. ! Item was changed: + ----- Method: MethodPragmaTest>>testSelector (in category 'tests-method') ----- - ----- Method: MethodPragmaTest>>testSelector (in category 'testing-method') ----- testSelector | pragma | pragma := self pragma: 'foo' selector: #bar. self assert: pragma selector == #bar.! Item was changed: + ----- Method: MethodPropertiesTest>>testAllMethodsHaveMethodClass (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAllMethodsHaveMethodClass (in category 'testing') ----- testAllMethodsHaveMethodClass Smalltalk garbageCollect. self assert: (CompiledMethod allInstances reject: [:cm | | lastLiteral | lastLiteral := cm literalAt: cm numLiterals. lastLiteral isVariableBinding and: [lastLiteral value isBehavior or: [lastLiteral value isTrait]]]) isEmpty description: 'CompiledMethods must have methodClass literal'! Item was changed: + ----- Method: MethodPropertiesTest>>testAt (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAt (in category 'testing') ----- testAt self should: [ method properties at: #zork ] raise: Error. self assert: (self propertyDictionaryFor: method) isEmpty. method properties at: #zork put: 'hello'. self assert: (method properties at: #zork) = 'hello'.! Item was changed: + ----- Method: MethodPropertiesTest>>testAtIfAbsent (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAtIfAbsent (in category 'testing') ----- testAtIfAbsent self assert: (method properties at: #zork ifAbsent: [ 'hello' ]) = 'hello'. self assert: (self propertyDictionaryFor: method) isEmpty. method properties at: #zork put: 'hi'. self assert: (method properties at: #zork ifAbsent: [ 'hello' ]) = 'hi'.! Item was changed: + ----- Method: MethodPropertiesTest>>testAtIfAbsentPut (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAtIfAbsentPut (in category 'testing') ----- testAtIfAbsentPut self assert: (method properties at: #zork ifAbsentPut: [ 'hello' ]) = 'hello'. self assert: (method properties at: #zork ifAbsentPut: [ 'hi' ]) = 'hello'.! Item was changed: + ----- Method: MethodPropertiesTest>>testAtPut (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAtPut (in category 'testing') ----- testAtPut self assert: (method properties at: #zork put: 'hello') = 'hello'. self assert: (method properties at: #zork) = 'hello'.! Item was changed: + ----- Method: MethodPropertiesTest>>testAtPutRepeatedly (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testAtPutRepeatedly (in category 'testing') ----- testAtPutRepeatedly self assert: (method properties at: #zork put: 'hello') = 'hello'. self assert: (method properties at: #zork put: 'hello') = 'hello'. self assert: (method properties at: #zork) = 'hello'.! Item was changed: + ----- Method: MethodPropertiesTest>>testIncludesKey (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testIncludesKey (in category 'testing') ----- testIncludesKey self deny: (method properties includesKey: #zork). self assert: (self propertyDictionaryFor: method) isEmpty. method properties at: #zork put: 123. self assert: (method properties includesKey: #zork).! Item was changed: + ----- Method: MethodPropertiesTest>>testRemoveKey (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testRemoveKey (in category 'testing') ----- testRemoveKey method properties at: #zork put: 'hello'. self should: [ method properties removeKey: #halt ] raise: Error. self assert: (method properties removeKey: #zork) = 'hello'. self assert: (self propertyDictionaryFor: method) isEmpty. self should: [ method properties removeKey: #zork ] raise: Error. self assert: (self propertyDictionaryFor: method) isEmpty.! Item was changed: + ----- Method: MethodPropertiesTest>>testRemoveKeyifAbsent (in category 'tests') ----- - ----- Method: MethodPropertiesTest>>testRemoveKeyifAbsent (in category 'testing') ----- testRemoveKeyifAbsent method properties at: #zork put: 'hello'. self assert: (method properties removeKey: #halt ifAbsent: [ 'hi' ]) = 'hi'. self assert: (method properties removeKey: #zork ifAbsent: [ 'hi' ]) = 'hello'. self assert: (self propertyDictionaryFor: method) isEmpty. self should: (method properties removeKey: #zork ifAbsent: [ 'hi' ]) = 'hi'. self assert: (self propertyDictionaryFor: method) isEmpty.! Item was changed: + ----- Method: MonitorTest>>testCheckOwnerProcess (in category 'tests') ----- - ----- Method: MonitorTest>>testCheckOwnerProcess (in category 'examples') ----- testCheckOwnerProcess self should: [Monitor new checkOwnerProcess] raise: Error. self shouldnt: [| m | m := Monitor new. m critical: [m checkOwnerProcess]] raise: Error. self should: [| s m | m := Monitor new. [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. m checkOwnerProcess] raise: Error! Item was changed: + ----- Method: MonitorTest>>testCriticalIfLocked (in category 'tests') ----- - ----- Method: MonitorTest>>testCriticalIfLocked (in category 'examples') ----- testCriticalIfLocked | m s | m := Monitor new. self assert: #unlocked == (m critical: [#unlocked] ifLocked: [#locked]). [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. self assert: #locked equals: (m critical: [#unlocked] ifLocked: [#locked])! Item was changed: + ----- Method: MonitorTest>>testExample1 (in category 'tests') ----- - ----- Method: MonitorTest>>testExample1 (in category 'examples') ----- testExample1 | producer1 producer2 monitor goal work counter goalReached finished | goal := (1 to: 1000) asOrderedCollection. work := OrderedCollection new. counter := 0. goalReached := false. finished := Semaphore new. monitor := Monitor new. producer1 := [ [monitor critical: [monitor waitUntil: [counter \\5 = 0]. goalReached or: [work add: (counter := counter + 1)]. goalReached := counter >= goal size. monitor signal ]. goalReached ] whileFalse. finished signal. ]. producer2 := [ [monitor critical: [monitor waitWhile: [counter \\5 = 0]. goalReached or: [work add: (counter := counter + 1)]. goalReached := counter >= goal size. monitor signal]. goalReached ] whileFalse. finished signal ]. producer1 forkAt: Processor userBackgroundPriority. producer2 forkAt: Processor userBackgroundPriority. finished wait; wait. self assert: goal = work! Item was changed: + ----- Method: MonitorTest>>testExample2 (in category 'tests') ----- - ----- Method: MonitorTest>>testExample2 (in category 'examples') ----- testExample2 "Here is a second version that does not use a semaphore to inform the forking process about termination of both forked processes" | producer1 producer2 monitor goal work counter goalReached activeProducers| goal := (1 to: 1000) asOrderedCollection. work := OrderedCollection new. counter := 0. goalReached := false. activeProducers := 0. monitor := Monitor new. producer1 := [ monitor critical: [activeProducers := activeProducers + 1]. [monitor critical: [monitor waitUntil: [counter \\5 = 0]. goalReached or: [work add: (counter := counter + 1)]. " Transcript show: 'P1 '; show: counter printString; show: ' '; show: activeProducers printString; cr." goalReached := counter >= goal size. monitor signal ]. goalReached ] whileFalse. monitor critical: [activeProducers := activeProducers - 1. monitor signal: #finish]. ] . producer2 := [monitor critical: [activeProducers := activeProducers + 1]. [monitor critical: [monitor waitWhile: [counter \\5 = 0]. goalReached or: [work add: (counter := counter + 1)]. goalReached := counter >= goal size. monitor signal]. goalReached ] whileFalse. monitor critical: [ activeProducers := activeProducers - 1. monitor signal: #finish]. ]. producer1 forkAt: Processor userBackgroundPriority. producer2 forkAt: Processor userBackgroundPriority. monitor critical: [ monitor waitUntil: [activeProducers = 0 & (goalReached)] for: #finish. ]. self assert: goal = work ! Item was changed: + ----- Method: MutexTest>>testCritical (in category 'tests') ----- - ----- Method: MutexTest>>testCritical (in category 'testing') ----- testCritical | lock | lock := Mutex new. [lock critical: [self criticalError]] forkAt: Processor userInterruptPriority. self deny: lock isOwned! Item was changed: + ----- Method: MutexTest>>testCriticalIfError (in category 'tests') ----- - ----- Method: MutexTest>>testCriticalIfError (in category 'testing') ----- testCriticalIfError | lock | lock := Mutex new. [lock critical: [self criticalError ifError: []]] forkAt: Processor userInterruptPriority. self deny: lock isOwned! Item was changed: + ----- Method: MutexTest>>testMutexAfterCriticalWait (in category 'tests') ----- - ----- Method: MutexTest>>testMutexAfterCriticalWait (in category 'testing') ----- testMutexAfterCriticalWait "self run: #testMutexAfterCriticalWait" "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: leaves it with the mutex correctly released." | lock p | lock := Mutex new. p := [lock critical: []] newProcess. p priority: Processor activePriority - 1. lock critical: "We now own it; p can't enter properly" [p resume. "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. self deny: lock isEmpty]. "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". p terminate. self deny: lock isOwned. self assert: lock isEmpty! Item was changed: + ----- Method: MutexTest>>testMutexCriticalBlockedInEnsure (in category 'tests') ----- - ----- Method: MutexTest>>testMutexCriticalBlockedInEnsure (in category 'testing') ----- testMutexCriticalBlockedInEnsure "self run: #testMutexCriticalBlockedInEnsure" "This tests whether a mutex that is in the ensure: in critical: but has yet to evaluate the valueNoContextSwitch leaves it with the mutex unlocked." | lock proc | lock := Mutex new. proc := [lock critical: []] newProcess. proc priority: Processor activePriority - 1. "step until in critical:" [proc suspendedContext selector == #critical:] whileFalse: [proc step]. "step until in ensure: (can't do this until in critical: cuz ensure: may be in newProcess etc...)" [proc suspendedContext selector == #ensure:] whileFalse: [proc step]. "Now check that the lock is owned." self assert: lock isOwned. "Now that proc is at the right point, resume the process and immediately terminate it." proc resume; terminate. self deny: lock isOwned. self assert: lock isEmpty! Item was changed: + ----- Method: MutexTest>>testMutexInCriticalWait (in category 'tests') ----- - ----- Method: MutexTest>>testMutexInCriticalWait (in category 'testing') ----- testMutexInCriticalWait "self run: #testMutexInCriticalWait" "This tests whether a mutex that has got past the primitiveEnterCriticalSection in Mutex>>critical: leaves it unowned." | lock sock proc | lock := Mutex new. sock := Semaphore new. proc := [lock critical: [sock wait]] fork. Processor yield. self assert: proc suspendingList == sock. proc terminate. self deny: lock isOwned. self assert: lock isEmpty! Item was changed: + ----- Method: MutexTest>>testTerminationOfLowPriorityProcessDoesNotShutOutHighPriorityProcess (in category 'tests') ----- - ----- Method: MutexTest>>testTerminationOfLowPriorityProcessDoesNotShutOutHighPriorityProcess (in category 'testing') ----- testTerminationOfLowPriorityProcessDoesNotShutOutHighPriorityProcess | m p s | m := Mutex new. p := [m critical: [Semaphore new wait]] forkAt: Processor activePriority - 10. (Delay forMilliseconds: 100) wait. "Allow p to enter critical section, owning m" [m critical: [s := #in]] forkAt: Processor activePriority + 10. "r := { p suspendedContext pc. p suspendedContext copyStack }." p terminate. self deny: m isOwned. self assert: s == #in. "(m isOwned not and: [s == #in]) ifFalse: [Debugger openContext: r last label: 'p' contents: nil]"! Item was changed: + ----- Method: MutexTest>>testTerminationOfOneOfTwoLowPriorityProcesses (in category 'tests') ----- - ----- Method: MutexTest>>testTerminationOfOneOfTwoLowPriorityProcesses (in category 'testing') ----- testTerminationOfOneOfTwoLowPriorityProcesses | mutex p1 p2 entered1 entered2 | mutex := Mutex new. entered1 := entered2 := false. p1 := [mutex critical:[entered1 := true]] forkAt: Processor activePriority - 1. p2 := [mutex critical:[entered2 := true]] forkAt: Processor activePriority - 2. mutex critical:[(Delay forMilliseconds: 100) wait]. p1 terminate. (Delay forMilliseconds: 100) wait. self deny: entered1. self assert: entered2! Item was changed: + ----- Method: ObjectTest>>testShouldBeImplemented (in category 'tests') ----- - ----- Method: ObjectTest>>testShouldBeImplemented (in category 'as yet unclassified') ----- testShouldBeImplemented | testClass | testClass := NotImplementedTestData. self should: [testClass new shouldBeImplementedMsg] raise: NotImplemented. [testClass new shouldBeImplementedMsg] ifError: [:errDesc | self assert: (errDesc includesSubstring: testClass name) description: 'Error should include class name'. self assert: (errDesc includesSubstring: #shouldBeImplementedMsg asString) description: 'Error should include selector name'].! Item was changed: + ----- Method: ObjectTest>>testShouldNotImplement (in category 'tests') ----- - ----- Method: ObjectTest>>testShouldNotImplement (in category 'as yet unclassified') ----- testShouldNotImplement | testClass | testClass := NotImplementedTestData. self should: [testClass new shouldNotImplementMsg] raise: NotImplemented. [testClass new shouldNotImplementMsg] ifError: [:errDesc | self assert: (errDesc includesSubstring: testClass name) description: 'Error should include class name'. self assert: (errDesc includesSubstring: #shouldNotImplementMsg asString) description: 'Error should include selector name'].! Item was changed: + ----- Method: ProcessSpecificTest>>checkDynamic: (in category 'private') ----- - ----- Method: ProcessSpecificTest>>checkDynamic: (in category 'testing') ----- checkDynamic: value self assert: value equals: TestDynamicVariable value.! Item was changed: + ----- Method: ProcessSpecificTest>>checkLocal: (in category 'private') ----- - ----- Method: ProcessSpecificTest>>checkLocal: (in category 'testing') ----- checkLocal: value self assert: value equals: TestLocalVariable value.! Item was changed: + ----- Method: ProcessSpecificTest>>testAssignmentToLocalVariableReturnsTheValue (in category 'tests') ----- - ----- Method: ProcessSpecificTest>>testAssignmentToLocalVariableReturnsTheValue (in category 'testing') ----- testAssignmentToLocalVariableReturnsTheValue self assert: 1 equals: (TestLocalVariable value: 1)! Item was changed: + ----- Method: ProcessSpecificTest>>testDynamicVariable (in category 'tests') ----- - ----- Method: ProcessSpecificTest>>testDynamicVariable (in category 'testing') ----- testDynamicVariable | s1 s2 p1stopped p2stopped | s1 := Semaphore new. s2 := Semaphore new. p1stopped := p2stopped := false. [ TestDynamicVariable value: 1 during:[ self checkDynamic: 1. (Delay forMilliseconds: 30) wait. self checkDynamic: 1. TestDynamicVariable value: 3 during:[ (Delay forMilliseconds: 30) wait. self checkDynamic: 3 ]. self checkDynamic: 1. ]. self checkDynamic: nil. p1stopped := true. s1 signal. ] fork. [ TestDynamicVariable value: 2 during:[ self checkDynamic: 2. (Delay forMilliseconds: 30) wait. self checkDynamic: 2. ]. self checkDynamic: nil. p2stopped := true. s2 signal. ] fork. "Set a maximum wait timeout so that the test case will complete even if the processes fail to signal us." s1 waitTimeoutSeconds: 2. s2 waitTimeoutSeconds: 2. self assert: p1stopped. self assert: p2stopped.! Item was changed: + ----- Method: ProcessSpecificTest>>testDynamicVariableDefault (in category 'tests') ----- - ----- Method: ProcessSpecificTest>>testDynamicVariableDefault (in category 'testing') ----- testDynamicVariableDefault "Just double-check our fixture." TestDynamicVariable default: #default. self assert: #default equals: TestDynamicVariable default. "Now check for default lookup out of any dynamic scope." self checkDynamic: #default.. "Ignore default value by setting dynamic scope." TestDynamicVariable value: #dynamic during: [ self checkDynamic: #dynamic]. "Out of that scope, we should fall back to the default again." self checkDynamic: #default. "...even if that default value changes." TestDynamicVariable default: #anotherDefault. self checkDynamic: #anotherDefault. ! Item was changed: + ----- Method: ProcessSpecificTest>>testLocalVariable (in category 'tests') ----- - ----- Method: ProcessSpecificTest>>testLocalVariable (in category 'testing') ----- testLocalVariable | s1 s2 p1stopped p2stopped | s1 := Semaphore new. s2 := Semaphore new. p1stopped := p2stopped := false. [ self checkLocal: 0. TestLocalVariable value: 1. self checkLocal: 1. (Delay forMilliseconds: 30) wait. self checkLocal: 1. TestLocalVariable value: 2. self checkLocal: 2. p1stopped := true. s1 signal. ] fork. [ (Delay forMilliseconds: 30) wait. self checkLocal: 0. TestLocalVariable value: 3. self checkLocal: 3. (Delay forMilliseconds: 30) wait. self checkLocal: 3. TestLocalVariable value: 4. self checkLocal: 4. p2stopped := true. s2 signal. ] fork. "Set a maximum wait timeout so that the test case will complete even if the processes fail to signal us." s1 waitTimeoutMSecs: 5000. s2 waitTimeoutMSecs: 5000. self assert: p1stopped. self assert: p2stopped. ! Item was changed: + ----- Method: ProcessTest>>testEnvironmentAt (in category 'tests') ----- - ----- Method: ProcessTest>>testEnvironmentAt (in category 'testing') ----- testEnvironmentAt Processor activeProcess environmentAt: #processTests put: 42. self assert: (Processor activeProcess environmentAt: #processTests) = 42. self should: [Processor activeProcess environmentAt: #foobar] raise: Error! Item was changed: + ----- Method: ProcessTest>>testEnvironmentAtPut (in category 'tests') ----- - ----- Method: ProcessTest>>testEnvironmentAtPut (in category 'testing') ----- testEnvironmentAtPut self assert: (Processor activeProcess environmentAt: #processTests put: 42) = 42.! Item was changed: + ----- Method: ProcessTest>>testEnvironmentRemoveKey (in category 'tests') ----- - ----- Method: ProcessTest>>testEnvironmentRemoveKey (in category 'testing') ----- testEnvironmentRemoveKey Processor activeProcess environmentAt: #processTests put: 42. Processor activeProcess environmentRemoveKey: #processTests. self assert: (Processor activeProcess environmentAt: #processTests ifAbsent: []) isNil. self should: [Processor activeProcess environmentAt: #processTests] raise: Error! Item was changed: + ----- Method: PromiseTest>>testAnErrorInThenRejectsPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testAnErrorInThenRejectsPromise (in category 'testing - monad') ----- testAnErrorInThenRejectsPromise | p q | p := Promise new. q := p then: [:v | KeyNotFound signal]. p resolveWith: 1. self deny: p isRejected description: 'Original Promise rejected'. self assert: q isRejected description: 'Broken Promise not rejected'.! Item was changed: + ----- Method: PromiseTest>>testCanRejectPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testCanRejectPromise (in category 'testing - monad') ----- testCanRejectPromise | p | p := Promise new. p rejectWith: Error new.! Item was changed: + ----- Method: PromiseTest>>testCannotRejectFulfilledPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testCannotRejectFulfilledPromise (in category 'testing - monad') ----- testCannotRejectFulfilledPromise | p | p := Promise unit: 1. p rejectWith: Error new. self assert: p isResolved. self assert: 1 equals: p value. ! Item was changed: + ----- Method: PromiseTest>>testCannotResolveaRejectedPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testCannotResolveaRejectedPromise (in category 'testing - monad') ----- testCannotResolveaRejectedPromise | p e | p := Promise new. e := Error new. p rejectWith: e. p resolveWith: 1. self assert: p isRejected. self assert: p error == e. ! Item was changed: + ----- Method: PromiseTest>>testChainedResolvers (in category 'tests') ----- - ----- Method: PromiseTest>>testChainedResolvers (in category 'testing') ----- testChainedResolvers | promise1 promise2 result | promise1 := Promise new. promise2 := Promise new. promise1 whenResolved: [:bool | promise2 resolveWith: bool not]. promise2 whenResolved: [:bool | result := bool]. promise1 resolveWith: false. self should: [result].! Item was changed: + ----- Method: PromiseTest>>testCollapsesChainsOfPromises (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testCollapsesChainsOfPromises (in category 'testing - monad') ----- testCollapsesChainsOfPromises "The monadic bind operator has signature (m a -> (a -> m b) -> m b): that is, in our setting, the block given to `then:` is expected to return a *Promise* of a value, not a value directly. It is convenient to accept non-promise values and automatically lift them into the monad, but we must also ensure we treat the case where a `then:`-block yields a Promise correctly." | p q r | p := Promise new. q := p then: [:v | Promise unit: v * 2]. r := q then: [:v | Promise unit: v + 1]. p resolveWith: 4. self assert: 4 * 2 equals: q value. self assert: (4 * 2 + 1) equals: r value.! Item was changed: + ----- Method: PromiseTest>>testFirstResolutionWins (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testFirstResolutionWins (in category 'testing - monad') ----- testFirstResolutionWins | p | p := Promise new. p resolveWith: 1. p resolveWith: 2. self assert: p isResolved. self assert: p value == 1. ! Item was changed: + ----- Method: PromiseTest>>testFulfillWithError (in category 'tests') ----- - ----- Method: PromiseTest>>testFulfillWithError (in category 'testing') ----- testFulfillWithError | p | p := Promise new. p fulfillWith: [ 1 / 0 ] passErrors: false. self assert: p isRejected. self assert: ZeroDivide equals: p error class.! Item was changed: + ----- Method: PromiseTest>>testFulfillWithHaltAndResult (in category 'tests') ----- - ----- Method: PromiseTest>>testFulfillWithHaltAndResult (in category 'testing') ----- testFulfillWithHaltAndResult | p | p := Promise new. [ p fulfillWith: [ self halt. 3 + 4 ] ] on: Halt do: [:ex | ex resume]. self assert: p isResolved. self assert: 7 equals: p value.! Item was changed: + ----- Method: PromiseTest>>testFulfillWithResult (in category 'tests') ----- - ----- Method: PromiseTest>>testFulfillWithResult (in category 'testing') ----- testFulfillWithResult | p | p := Promise new. p fulfillWith: [ 3 + 4 ]. self assert: p isResolved. self assert: 7 equals: p value.! Item was changed: + ----- Method: PromiseTest>>testFutureRejectionInvisibleError (in category 'tests - future') ----- - ----- Method: PromiseTest>>testFutureRejectionInvisibleError (in category 'testing - future') ----- testFutureRejectionInvisibleError | p | p := 1 future / 0. p whenRejected: []. "Installing a rejection handler is enough to cause the exception to be swallowed." self assert: (self waitUntil: [p isRejected] orCycleCount: 100). self assert: p isRejected. self assert: ZeroDivide equals: p error class.! Item was changed: + ----- Method: PromiseTest>>testFutureRejectionVisibleError (in category 'tests - future') ----- - ----- Method: PromiseTest>>testFutureRejectionVisibleError (in category 'testing - future') ----- testFutureRejectionVisibleError | p | p := 1 future / 0. [ self assert: (self waitUntil: [p isRejected] orCycleCount: 100) ] on: ZeroDivide do: [:ex | "Fall through." ]. self assert: p isRejected. self assert: ZeroDivide equals: p error class.! Item was changed: + ----- Method: PromiseTest>>testFutureResolution (in category 'tests - future') ----- - ----- Method: PromiseTest>>testFutureResolution (in category 'testing - future') ----- testFutureResolution | p | p := 3 future + 4. self assert: (self waitUntil: [p isResolved] orCycleCount: 100). self assert: p isResolved. self assert: 7 equals: p value.! Item was changed: + ----- Method: PromiseTest>>testMultipleResolvers (in category 'tests') ----- - ----- Method: PromiseTest>>testMultipleResolvers (in category 'testing') ----- testMultipleResolvers | promise sum | sum := 0. promise := Promise new. 5 timesRepeat: [ promise whenResolved: [:val | sum := sum + val]. ]. promise resolveWith: 5. self should: [sum = 25]. ! Item was changed: + ----- Method: PromiseTest>>testRejectWithInvokesErrorHandlers (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testRejectWithInvokesErrorHandlers (in category 'testing - monad') ----- testRejectWithInvokesErrorHandlers | p error returnedError | returnedError := nil. error := KeyNotFound new. p := Promise ifRejected: [:e | returnedError := e]. p rejectWith: error. self assert: returnedError notNil description: 'Error block did not run.'. self assert: error equals: returnedError description: 'Error not passed into block'. self assert: error equals: p error description: 'Promise didn''t store error'.! Item was changed: + ----- Method: PromiseTest>>testSingleResolver (in category 'tests') ----- - ----- Method: PromiseTest>>testSingleResolver (in category 'testing') ----- testSingleResolver | promise sum | sum := 0. promise := Promise new. promise whenResolved: [:val | sum := sum + val]. promise resolveWith: 5. self assert: 5 equals: sum. ! Item was changed: + ----- Method: PromiseTest>>testThenPermitsChainingOfPromises (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testThenPermitsChainingOfPromises (in category 'testing - monad') ----- testThenPermitsChainingOfPromises | p q r | p := Promise new. q := p then: [:v | v * 2]. r := q then: [:v | v + 1]. p resolveWith: 4. self assert: 4 * 2 equals: q value. self assert: (4 * 2 + 1) equals: r value.! Item was changed: + ----- Method: PromiseTest>>testThenReturnsaPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testThenReturnsaPromise (in category 'testing - monad') ----- testThenReturnsaPromise | p | p := Promise new then: [:v | v * 2]. self assert: Promise equals: p class.! Item was changed: + ----- Method: PromiseTest>>testTimeout (in category 'tests') ----- - ----- Method: PromiseTest>>testTimeout (in category 'testing') ----- testTimeout | promise | promise := Promise new. self shouldnt: [promise waitTimeoutMSecs: 1]. self shouldnt: [promise isResolved]. self shouldnt: [promise isRejected]. promise resolveWith: 45. self should: [promise waitTimeoutMSecs: 1]. self should: [promise isResolved]. self shouldnt: [promise isRejected].! Item was changed: + ----- Method: PromiseTest>>testTimeoutRejected (in category 'tests') ----- - ----- Method: PromiseTest>>testTimeoutRejected (in category 'testing') ----- testTimeoutRejected | promise | promise := Promise new. self shouldnt: [promise waitTimeoutMSecs: 1]. self shouldnt: [promise isResolved]. self shouldnt: [promise isRejected]. promise rejectWith: 45. self shouldnt: [promise waitTimeoutMSecs: 1]. self shouldnt: [promise isResolved]. self should: [promise isRejected].! Item was changed: + ----- Method: PromiseTest>>testUnitReturnsaPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testUnitReturnsaPromise (in category 'testing - monad') ----- testUnitReturnsaPromise | p | p := Promise unit: 1. self assert: Promise equals: p class. self assert: p isResolved.! Item was changed: + ----- Method: PromiseTest>>testWaitForRejection (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testWaitForRejection (in category 'testing - monad') ----- testWaitForRejection | p | p := Promise new. [ (Delay forMilliseconds: 1) wait. p rejectWith: Error new ] fork. self should: [ p wait ] raise: BrokenPromise.! Item was changed: + ----- Method: PromiseTest>>testWaitForResolution (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testWaitForResolution (in category 'testing - monad') ----- testWaitForResolution | p | p := Promise new. [ (Delay forMilliseconds: 1) wait. p resolveWith: #ok ] fork. self assert: [ p wait = #ok ]! Item was changed: + ----- Method: PromiseTest>>testWaitRejectionYieldsCorrectBrokenPromise (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testWaitRejectionYieldsCorrectBrokenPromise (in category 'testing - monad') ----- testWaitRejectionYieldsCorrectBrokenPromise | p | p := Promise new. [ (Delay forMilliseconds: 1) wait. p rejectWith: Error new ] fork. [ p wait ] on: BrokenPromise do: [ :bp | ^ self assert: [ bp promise == p ] ]. self fail: 'Should not reach this point'! Item was changed: + ----- Method: PromiseTest>>testifRejectedDoesNotRunBlockIfPromiseResolves (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testifRejectedDoesNotRunBlockIfPromiseResolves (in category 'testing - monad') ----- testifRejectedDoesNotRunBlockIfPromiseResolves | p q error | error := nil. p := Promise new. q := p ifRejected: [:e | error := e]. p resolveWith: 1. self deny: q isRejected. self assert: nil equals: error.! Item was changed: + ----- Method: PromiseTest>>testifRejectedRunsBlockIfPromiseFails (in category 'tests - monad') ----- - ----- Method: PromiseTest>>testifRejectedRunsBlockIfPromiseFails (in category 'testing - monad') ----- testifRejectedRunsBlockIfPromiseFails | p q error | error := nil. p := Promise new. q := p ifRejected: [:e | error := e]. p rejectWith: KeyNotFound new. self assert: q isRejected. self assert: KeyNotFound equals: error class.! Item was changed: + ----- Method: PromiseTest>>waitUntil:orCycleCount: (in category 'private') ----- - ----- Method: PromiseTest>>waitUntil:orCycleCount: (in category 'testing - future') ----- waitUntil: aBlock orCycleCount: anInteger "This is a gross hack that depends on running the tests in Morphic. We simply repeatedly do a cycle of the interaction loop, which happens to also be the way that the queue of pending futures gets serviced." | counter | counter := 0. [ aBlock value ifTrue: [^ true]. World doOneSubCycle. counter := counter + 1. counter >= anInteger ifTrue: [^ false]. ] repeat! Item was changed: + ----- Method: SemaphoreTest>>testCritical (in category 'tests') ----- - ----- Method: SemaphoreTest>>testCritical (in category 'testing') ----- testCritical | lock | lock := Semaphore forMutualExclusion. [lock critical: [self criticalError]] forkAt: Processor userInterruptPriority. self assert: lock isSignaled! Item was changed: + ----- Method: SemaphoreTest>>testCriticalIfError (in category 'tests') ----- - ----- Method: SemaphoreTest>>testCriticalIfError (in category 'testing') ----- testCriticalIfError | lock | lock := Semaphore forMutualExclusion. [lock critical: [self criticalError ifError:[]]] forkAt: Processor userInterruptPriority. self assert: lock isSignaled! Item was changed: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWait (in category 'tests') ----- - ----- Method: SemaphoreTest>>testSemaAfterCriticalWait (in category 'testing') ----- testSemaAfterCriticalWait "self run: #testSemaAfterCriticalWait" "This tests whether a semaphore that has just left the wait in Semaphore>>critical: leaves it with signaling the associated semaphore." | s p | s := Semaphore new. p := [s critical:[]] forkAt: Processor activePriority-1. "wait until p entered the critical section" [p suspendingList == s] whileFalse:[(Delay forMilliseconds: 10) wait]. "Now that p entered it, signal the semaphore. p now 'owns' the semaphore but since we are running at higher priority than p it will not get to do anything." s signal. p terminate. self assert: 1 equals: s excessSignals! Item was changed: + ----- Method: SemaphoreTest>>testSemaCriticalBlockedInEnsure (in category 'tests') ----- - ----- Method: SemaphoreTest>>testSemaCriticalBlockedInEnsure (in category 'testing') ----- testSemaCriticalBlockedInEnsure "self run: #testSemaCriticalBlockedInEnsure" "This tests whether a semaphore that is in ensure: but has yet to evaluate the valueNoContextSwitch leaves it with signaling the associated semaphore." | decompilation needSignalToEnterEnsure s p | "Distinguish between e.g. critical: t1 <criticalSection> ^[self wait. t1 value] ensure: [self signal] and critical: t1 <criticalSection> self wait. ^t1 ensure: [self signal]" decompilation := (Semaphore>>#critical:) decompileString. needSignalToEnterEnsure := (decompilation indexOfSubCollection: #wait) < (decompilation indexOf: $[). s := Semaphore new. needSignalToEnterEnsure ifTrue: [s signal]. p := [s critical: []] newProcess. p priority: Processor activePriority - 1. "step until in critical:" [p suspendedContext selector == #critical:] whileFalse: [p step]. "step until in ensure: (can't do this until in critical: cuz ensure: may be in newProcess etc...)" [p suspendedContext selector == #ensure:] whileFalse: [p step]. "Now check that if we needed a signal to enter ensure: it has been consumed." self assert: 0 equals: s excessSignals. "Now that p is at the right point, resume the process and immediately terminate it." p resume; terminate. self assert: (needSignalToEnterEnsure ifTrue: [1] ifFalse: [0]) equals: s excessSignals! Item was changed: + ----- Method: SemaphoreTest>>testSemaInCriticalWait (in category 'tests') ----- - ----- Method: SemaphoreTest>>testSemaInCriticalWait (in category 'testing') ----- testSemaInCriticalWait "self run: #testSemaInCriticalWait" "This tests whether a semaphore that has entered the wait in Semaphore>>critical: leaves it without signaling the associated semaphore." | s p | s := Semaphore new. p := [s critical:[]] fork. Processor yield. self assert:(p suspendingList == s). p terminate. self assert: 0 equals: s excessSignals! Item was changed: + ----- Method: SemaphoreTest>>testWaitAndWaitTimeoutTogether (in category 'tests') ----- - ----- Method: SemaphoreTest>>testWaitAndWaitTimeoutTogether (in category 'testing') ----- testWaitAndWaitTimeoutTogether | semaphore value waitProcess waitTimeoutProcess | semaphore := Semaphore new. waitProcess := [semaphore wait. value := #wait] fork. waitTimeoutProcess := [semaphore waitTimeoutMSecs: 50. value := #waitTimeout] fork. "Wait for the timeout to happen" (Delay forMilliseconds: 100) wait. "The waitTimeoutProcess should already have timed out. This should release the waitProcess" semaphore signal. [waitProcess isTerminated and: [waitTimeoutProcess isTerminated]] whileFalse: [(Delay forMilliseconds: 100) wait]. self assert: value = #wait. ! Item was changed: + ----- Method: SemaphoreTest>>testWaitTimeoutMSecs (in category 'tests') ----- - ----- Method: SemaphoreTest>>testWaitTimeoutMSecs (in category 'testing') ----- testWaitTimeoutMSecs "Ensure that waitTimeoutMSecs behaves properly" "Ensure that a timed out waitTimeoutMSecs: returns true from the wait" self assert: (Semaphore new waitTimeoutMSecs: 50) == true. "Ensure that a signaled waitTimeoutMSecs: returns false from the wait" self assert: (Semaphore new signal waitTimeoutMSecs: 50) == false. ! Item was changed: + ----- Method: SmallIntegerTest>>testBasicNew (in category 'tests - Class Methods') ----- - ----- Method: SmallIntegerTest>>testBasicNew (in category 'testing - Class Methods') ----- testBasicNew self should: [SmallInteger basicNew] raise: TestResult error. ! Item was changed: + ----- Method: SmallIntegerTest>>testDecimalDigitLength (in category 'tests - printing') ----- - ----- Method: SmallIntegerTest>>testDecimalDigitLength (in category 'testing - printing') ----- testDecimalDigitLength | x length random | "Test edge cases" x := 1. length := 1. [ x <= SmallInteger maxVal ] whileTrue: [ self assert: length equals: x decimalDigitLength; assert: (length - 1 max: 1) equals: (x - 1) decimalDigitLength. x := x * 10. length := length + 1 ]. "A few values by hand" #( 0 1 4 1 12 2 123 3 1234 4 56789 5 657483 6 6571483 7 65174383 8 625744831 9 1000001111 10 ), { SmallInteger maxVal. Smalltalk wordSize = 8 ifTrue: [ 19 ] ifFalse: [ 10 ] } groupsDo: [ :input :expectedOutput | self assert: expectedOutput equals: input decimalDigitLength ]. "Pseudorandom tests." random := Random seed: 36rSqueak. 10000 timesRepeat: [ x := SmallInteger maxVal atRandom: random. self assert: x asString size equals: x decimalDigitLength ]! Item was changed: + ----- Method: SmallIntegerTest>>testDivide (in category 'tests - arithmetic') ----- - ----- Method: SmallIntegerTest>>testDivide (in category 'testing - arithmetic') ----- testDivide self assert: 2 / 1 = 2. self assert: (3 / 2) isFraction. self assert: 4 / 2 = 2. self should: [ 1 / 0 ] raise: ZeroDivide.! Item was changed: + ----- Method: SmallIntegerTest>>testEven (in category 'tests - basic') ----- - ----- Method: SmallIntegerTest>>testEven (in category 'testing - basic') ----- testEven self assert: (SmallInteger minVal even). self deny: (SmallInteger maxVal even). self deny: ((SmallInteger minVal + 1) even). self assert: ((SmallInteger maxVal - 1) even). self deny: (1 even). self deny: (-1 even). self assert: (2 even). self assert: (-2 even). self assert: (0 even).! Item was changed: + ----- Method: SmallIntegerTest>>testMaxVal (in category 'tests - Class Methods') ----- - ----- Method: SmallIntegerTest>>testMaxVal (in category 'testing - Class Methods') ----- testMaxVal self assert: (SmallInteger maxVal = 16r3FFFFFFF or: [SmallInteger maxVal = 16rFFFFFFFFFFFFFFF]).! Item was changed: + ----- Method: SmallIntegerTest>>testMinVal (in category 'tests - Class Methods') ----- - ----- Method: SmallIntegerTest>>testMinVal (in category 'testing - Class Methods') ----- testMinVal self assert: (SmallInteger minVal = -16r40000000 or: [SmallInteger minVal = -16r1000000000000000]).! Item was changed: + ----- Method: SmallIntegerTest>>testNew (in category 'tests - Class Methods') ----- - ----- Method: SmallIntegerTest>>testNew (in category 'testing - Class Methods') ----- testNew self should: [SmallInteger new] raise: TestResult error. ! Item was changed: + ----- Method: SmallIntegerTest>>testOdd (in category 'tests - basic') ----- - ----- Method: SmallIntegerTest>>testOdd (in category 'testing - basic') ----- testOdd self deny: (SmallInteger minVal odd). self assert: (SmallInteger maxVal odd). self assert: ((SmallInteger minVal + 1) odd). self deny: ((SmallInteger maxVal - 1) odd). self assert: (1 odd). self assert: (-1 odd). self deny: (2 odd). self deny: (-2 odd). self deny: (0 odd).! Item was changed: + ----- Method: SmallIntegerTest>>testPrintPaddedWith (in category 'tests - printing') ----- - ----- Method: SmallIntegerTest>>testPrintPaddedWith (in category 'testing - printing') ----- testPrintPaddedWith self assert: (123 printPaddedWith: $0 to: 10 base: 2) = '0001111011'. self assert: (123 printPaddedWith: $0 to: 10 base: 8) = '0000000173'. self assert: (123 printPaddedWith: $0 to: 10 base: 10) = '0000000123'. self assert: (123 printPaddedWith: $0 to: 10 base: 16) = '000000007B'.! Item was changed: + ----- Method: SmallIntegerTest>>testPrintString (in category 'tests - printing') ----- - ----- Method: SmallIntegerTest>>testPrintString (in category 'testing - printing') ----- testPrintString self assert: 1 printString = '1'. self assert: -1 printString = '-1'. self assert: SmallInteger minVal printString = (Smalltalk wordSize = 8 ifTrue: [ '-1152921504606846976'] ifFalse: ['-1073741824']). self assert: SmallInteger maxVal printString = (Smalltalk wordSize = 8 ifTrue: [ '1152921504606846975'] ifFalse: ['1073741823']). self assert: 12345 printString = '12345'. self assert: -54321 printString = '-54321'! Item was changed: + ----- Method: TrueTest>>testAND (in category 'tests') ----- - ----- Method: TrueTest>>testAND (in category 'testing') ----- testAND self assert: (true & true) = true. self assert: (true & false) = false.! Item was changed: + ----- Method: TrueTest>>testAnd (in category 'tests') ----- - ----- Method: TrueTest>>testAnd (in category 'testing') ----- testAnd self assert: (true and: ['alternativeBlock']) = 'alternativeBlock'.! Item was changed: + ----- Method: TrueTest>>testAsBit (in category 'tests') ----- - ----- Method: TrueTest>>testAsBit (in category 'testing') ----- testAsBit self assert: (true asBit = 1).! Item was changed: + ----- Method: TrueTest>>testIfFalse (in category 'tests') ----- - ----- Method: TrueTest>>testIfFalse (in category 'testing') ----- testIfFalse self assert: (true ifFalse: ['alternativeBlock']) = nil. ! Item was changed: + ----- Method: TrueTest>>testIfFalseIfTrue (in category 'tests') ----- - ----- Method: TrueTest>>testIfFalseIfTrue (in category 'testing') ----- testIfFalseIfTrue self assert: (true ifFalse: ['falseAlternativeBlock'] ifTrue: ['trueAlternativeBlock']) = 'trueAlternativeBlock'. ! Item was changed: + ----- Method: TrueTest>>testIfTrue (in category 'tests') ----- - ----- Method: TrueTest>>testIfTrue (in category 'testing') ----- testIfTrue self assert: (true ifTrue: ['alternativeBlock']) = 'alternativeBlock'. ! Item was changed: + ----- Method: TrueTest>>testIfTrueIfFalse (in category 'tests') ----- - ----- Method: TrueTest>>testIfTrueIfFalse (in category 'testing') ----- testIfTrueIfFalse self assert: (true ifTrue: ['trueAlternativeBlock'] ifFalse: ['falseAlternativeBlock']) = 'trueAlternativeBlock'. ! Item was changed: + ----- Method: TrueTest>>testInMemory (in category 'tests') ----- - ----- Method: TrueTest>>testInMemory (in category 'testing') ----- testInMemory self assert: (true isInMemory = true).! Item was changed: + ----- Method: TrueTest>>testNew (in category 'tests') ----- - ----- Method: TrueTest>>testNew (in category 'testing') ----- testNew self should: [True new] raise: Error. ! Item was changed: + ----- Method: TrueTest>>testNot (in category 'tests') ----- - ----- Method: TrueTest>>testNot (in category 'testing') ----- testNot self assert: (true not = false).! Item was changed: + ----- Method: TrueTest>>testOR (in category 'tests') ----- - ----- Method: TrueTest>>testOR (in category 'testing') ----- testOR self assert: (true | true) = true. self assert: (true | false) = true.! Item was changed: + ----- Method: TrueTest>>testOr (in category 'tests') ----- - ----- Method: TrueTest>>testOr (in category 'testing') ----- testOr self assert: (true or: ['alternativeBlock']) = true.! Item was changed: + ----- Method: TrueTest>>testPrintOn (in category 'tests') ----- - ----- Method: TrueTest>>testPrintOn (in category 'testing') ----- testPrintOn self assert: (String streamContents: [:stream | true printOn: stream]) = 'true'. ! Item was changed: + ----- Method: TrueTest>>testXor (in category 'tests') ----- - ----- Method: TrueTest>>testXor (in category 'testing') ----- testXor self assert: (true xor: true) = false. self assert: (true xor: false) = true. self assert: (true xor: [true]) = false. self assert: (true xor: [false]) = true. "Verify that boolean with non-boolean raise errors." self should: [true xor: [1]] raise: Error. self should: [true xor: 1] raise: Error.!

1 0

The Trunk: SUnit-pre.115.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of SUnit to project The Trunk: http://source.squeak.org/trunk/SUnit-pre.115.mcz ==================== Summary ==================== Name: SUnit-pre.115 Author: pre Time: 30 April 2019, 7:18:47.687906 pm UUID: 447c12dd-c108-094a-9327-ef47edc61497 Ancestors: SUnit-cypress.1, SUnit-fn.114 Recategorizes test methods in SUnit to create a good example to start from. =============== Diff against SUnit-fn.114 =============== Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>setUp (in category 'running') ----- - ----- Method: ClassFactoryForTestCaseTest>>setUp (in category 'setUp-tearDown') ----- setUp super setUp. factory := ClassFactoryForTestCase new! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>tearDown (in category 'running') ----- - ----- Method: ClassFactoryForTestCaseTest>>tearDown (in category 'setUp-tearDown') ----- tearDown super tearDown. factory cleanUp! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testClassCreationInDifferentCategories (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testClassCreationInDifferentCategories (in category 'testing') ----- testClassCreationInDifferentCategories | firstThreeClasses lastTwoClasses | 3 timesRepeat: [ factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #One]. firstThreeClasses := factory createdClasses copy. 2 timesRepeat: [ factory newSubclassOf: Object instanceVariableNames: '' classVariableNames: '' category: #Two]. lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses. self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]). self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testClassFastCreationInDifferentCategories (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testClassFastCreationInDifferentCategories (in category 'testing') ----- testClassFastCreationInDifferentCategories | firstThreeClasses lastTwoClasses | 3 timesRepeat: [ factory newClassInCategory: #One]. firstThreeClasses := factory createdClasses copy. 2 timesRepeat: [ factory newClassInCategory: #Two]. lastTwoClasses := factory createdClasses copyWithoutAll: firstThreeClasses. self assert: (firstThreeClasses allSatisfy: [:class| class category = (factory packageName, '-', #One) asSymbol]). self assert: (lastTwoClasses allSatisfy: [:class| class category = (factory packageName, '-', #Two) asSymbol]).! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testDefaultCategoryCleanUp (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testDefaultCategoryCleanUp (in category 'testing') ----- testDefaultCategoryCleanUp | createdClassNames allClasses | 3 timesRepeat: [ factory newClass]. createdClassNames := factory createdClassNames. factory cleanUp. self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). allClasses := SystemNavigation new allClasses. self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]). self deny: (SystemOrganization categories includes: factory defaultCategory). self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames) ! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testMultipleClassCreation (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testMultipleClassCreation (in category 'testing') ----- testMultipleClassCreation 5 timesRepeat: [ factory newClass]. self assert: (SystemNavigation new allClasses includesAllOf: factory createdClasses). self assert: factory createdClassNames asSet size = 5. self assert: (SystemOrganization listAtCategoryNamed: factory defaultCategory) asSet = factory createdClassNames asSet! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testPackageCleanUp (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testPackageCleanUp (in category 'testing') ----- testPackageCleanUp | createdClassNames allClasses | 3 timesRepeat: [ factory newClassInCategory: #One]. 2 timesRepeat: [ factory newClassInCategory: #Two]. createdClassNames := factory createdClassNames. factory cleanUp. self assert: (factory createdClasses allSatisfy: [:class| class isObsolete]). allClasses := SystemNavigation new allClasses. self assert: (factory createdClasses noneSatisfy: [:class| allClasses includes: class]). self assert: (SystemOrganization categoriesMatching: factory packageName, '*') isEmpty. self deny: (ChangeSet current changedClassNames includesAnyOf: createdClassNames) ! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testSingleClassCreation (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testSingleClassCreation (in category 'testing') ----- testSingleClassCreation |class elementsInCategoryForTest | class := factory newSubclassOf: Object instanceVariableNames: 'a b c' classVariableNames: 'X Y'. self assert: (SystemNavigation new allClasses includes: class). elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. self assert: elementsInCategoryForTest = {class name}. self assert: class instVarNames = #(a b c). self assert: class classPool keys asSet = #(X Y) asSet! Item was changed: + ----- Method: ClassFactoryForTestCaseTest>>testSingleClassFastCreation (in category 'tests') ----- - ----- Method: ClassFactoryForTestCaseTest>>testSingleClassFastCreation (in category 'testing') ----- testSingleClassFastCreation |class elementsInCategoryForTest | class := factory newClass. self assert: (SystemNavigation new allClasses includes: class). elementsInCategoryForTest := SystemOrganization listAtCategoryNamed: factory defaultCategory. self assert: elementsInCategoryForTest = {class name}. self assert: class instVarNames isEmpty. self assert: class classPool isEmpty! Item was changed: + ----- Method: ClassTestCase>>selectorsTested (in category 'coverage') ----- - ----- Method: ClassTestCase>>selectorsTested (in category 'Coverage') ----- selectorsTested | literals | literals := Set new. self class selectorsAndMethodsDo: [ :s :m | (s beginsWith: 'test') ifTrue: [ literals addAll: (m messages)] ]. ^ literals sorted! Item was changed: + ----- Method: LongTestCase>>defaultTimeout (in category 'accessing') ----- - ----- Method: LongTestCase>>defaultTimeout (in category 'as yet unclassified') ----- defaultTimeout "Answer the default timeout to use for tests in this test case. The timeout is a value in seconds." ^super defaultTimeout * 10! Item was changed: + ----- Method: LongTestCaseTest>>setUp (in category 'running') ----- - ----- Method: LongTestCaseTest>>setUp (in category 'as yet unclassified') ----- setUp preferenceValue := LongTestCase shouldRun! Item was changed: + ----- Method: LongTestCaseTest>>tearDown (in category 'running') ----- - ----- Method: LongTestCaseTest>>tearDown (in category 'as yet unclassified') ----- tearDown LongTestCase shouldRun: preferenceValue! Item was changed: + ----- Method: LongTestCaseTest>>testLongTestCaseDoNotRun (in category 'tests') ----- - ----- Method: LongTestCaseTest>>testLongTestCaseDoNotRun (in category 'testing') ----- testLongTestCaseDoNotRun "self debug: #testLongTestCaseDoNotRun" "self run: #testLongTestCaseDoNotRun" LongTestCase doNotRunLongTestCases. LongTestCaseTestUnderTest markAsNotRun. self deny: LongTestCaseTestUnderTest hasRun. LongTestCaseTestUnderTest suite run. self deny: LongTestCaseTestUnderTest hasRun. ! Item was changed: + ----- Method: LongTestCaseTest>>testLongTestCaseRun (in category 'tests') ----- - ----- Method: LongTestCaseTest>>testLongTestCaseRun (in category 'testing') ----- testLongTestCaseRun "self debug: #testLongTestCaseRun" "self run: #testLongTestCaseRun" LongTestCase runLongTestCases. LongTestCaseTestUnderTest markAsNotRun. self deny: LongTestCaseTestUnderTest hasRun. LongTestCaseTestUnderTest suite run. self assert: LongTestCaseTestUnderTest hasRun. LongTestCase doNotRunLongTestCases. ! Item was changed: + ----- Method: LongTestCaseTestUnderTest>>testWhenRunMarkTestedToTrue (in category 'tests') ----- - ----- Method: LongTestCaseTestUnderTest>>testWhenRunMarkTestedToTrue (in category 'testing') ----- testWhenRunMarkTestedToTrue RunStatus := true.! Item was changed: + ----- Method: ResumableTestFailureTestCase>>errorTest (in category 'data') ----- - ----- Method: ResumableTestFailureTestCase>>errorTest (in category 'not categorized') ----- errorTest 1 zork ! Item was changed: + ----- Method: ResumableTestFailureTestCase>>failureTest (in category 'data') ----- - ----- Method: ResumableTestFailureTestCase>>failureTest (in category 'not categorized') ----- failureTest self assert: false description: 'You should see me' resumable: true; assert: false description: 'You should see me too' resumable: true; assert: false description: 'You should see me last' resumable: false; assert: false description: 'You should not see me' resumable: true ! Item was changed: + ----- Method: ResumableTestFailureTestCase>>okTest (in category 'data') ----- - ----- Method: ResumableTestFailureTestCase>>okTest (in category 'not categorized') ----- okTest self assert: true ! Item was changed: + ----- Method: ResumableTestFailureTestCase>>regularTestFailureTest (in category 'data') ----- - ----- Method: ResumableTestFailureTestCase>>regularTestFailureTest (in category 'not categorized') ----- regularTestFailureTest self assert: false description: 'You should see me' ! Item was changed: + ----- Method: ResumableTestFailureTestCase>>resumableTestFailureTest (in category 'data') ----- - ----- Method: ResumableTestFailureTestCase>>resumableTestFailureTest (in category 'not categorized') ----- resumableTestFailureTest self assert: false description: 'You should see me' resumable: true; assert: false description: 'You should see me too' resumable: true; assert: false description: 'You should see me last' resumable: false; assert: false description: 'You should not see me' resumable: true ! Item was changed: + ----- Method: ResumableTestFailureTestCase>>testResumable (in category 'tests') ----- - ----- Method: ResumableTestFailureTestCase>>testResumable (in category 'not categorized') ----- testResumable | result suite | suite := TestSuite new. suite addTest: (self class selector: #errorTest). suite addTest: (self class selector: #regularTestFailureTest). suite addTest: (self class selector: #resumableTestFailureTest). suite addTest: (self class selector: #okTest). result := suite run. self assert: result failures size = 2; assert: result errors size = 1 ! Item was changed: + ----- Method: SUnitExtensionsTest>>testAssertionFailedInRaiseWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testAssertionFailedInRaiseWithExceptionDo (in category 'test') ----- testAssertionFailedInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #assertionFailedInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. ! Item was changed: + ----- Method: SUnitExtensionsTest>>testAutoAssertFalse (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testAutoAssertFalse (in category 'test') ----- testAutoAssertFalse | booleanCondition | self assert: self isLogging. self should: [ self assert: 1 = 2 description: 'self assert: 1 = 2' ] raise: TestResult failure. booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self assert: 1 = 2'. self assert: booleanCondition! Item was changed: + ----- Method: SUnitExtensionsTest>>testAutoAssertTrue (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testAutoAssertTrue (in category 'test') ----- testAutoAssertTrue self assert: 1 = 1. self assert: true! Item was changed: + ----- Method: SUnitExtensionsTest>>testAutoDenyFalse (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testAutoDenyFalse (in category 'test') ----- testAutoDenyFalse | booleanCondition | self assert: self isLogging. self should: [ self deny: 1 = 1 description: 'self deny: 1 = 1'.] raise: TestResult failure. booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self deny: 1 = 1'. self assert: booleanCondition! Item was changed: + ----- Method: SUnitExtensionsTest>>testAutoDenyTrue (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testAutoDenyTrue (in category 'test') ----- testAutoDenyTrue self deny: 1 = 2. self deny: false! Item was changed: + ----- Method: SUnitExtensionsTest>>testDifferentExceptionInShouldRaiseWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testDifferentExceptionInShouldRaiseWithExceptionDo (in category 'test') ----- testDifferentExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #differentExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult errors isEmpty. self assert: testResult failures isEmpty. self assert: testResult passed size=1! Item was changed: + ----- Method: SUnitExtensionsTest>>testEnsureInternetFails (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testEnsureInternetFails (in category 'test') ----- testEnsureInternetFails self should: [self ensureInternetConnectionTo: ''] raise: Error! Item was changed: + ----- Method: SUnitExtensionsTest>>testErrorInRaiseWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testErrorInRaiseWithExceptionDo (in category 'test') ----- testErrorInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #errorInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult errors includes: testCase). self assert: testResult errors size=1. self assert: testResult failures isEmpty. self assert: testResult passed isEmpty. ! Item was changed: + ----- Method: SUnitExtensionsTest>>testExceptionWithMatchingString (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testExceptionWithMatchingString (in category 'as yet unclassified') ----- testExceptionWithMatchingString self should: [ Object obsolete ] raise: Error whoseDescriptionIncludes: 'NOT obsolete' description: 'tested obsoleting Object'! Item was changed: + ----- Method: SUnitExtensionsTest>>testExceptionWithoutMatchingString (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testExceptionWithoutMatchingString (in category 'as yet unclassified') ----- testExceptionWithoutMatchingString self should: [ Object obsolete ] raise: Error whoseDescriptionDoesNotInclude: 'Zero' description: 'tested obsoleting Object'! Item was changed: + ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThan (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThan (in category 'test') ----- testInvalidShouldNotTakeMoreThan | testCase testResult | testCase := self class selector: #invalidShouldNotTakeMoreThan. testResult := testCase run. self assert: testResult passed isEmpty. self assert: testResult failures size = 1. self assert: (testResult failures includes: testCase). self assert: testResult errors isEmpty ! Item was changed: + ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThanMilliseconds (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testInvalidShouldNotTakeMoreThanMilliseconds (in category 'test') ----- testInvalidShouldNotTakeMoreThanMilliseconds | testCase testResult | testCase := self class selector: #invalidShouldNotTakeMoreThanMilliseconds. testResult := testCase run. self assert: testResult passed isEmpty. self assert: testResult failures size = 1. self assert: (testResult failures includes: testCase). self assert: testResult errors isEmpty ! Item was changed: + ----- Method: SUnitExtensionsTest>>testNoExceptionInShouldRaiseWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testNoExceptionInShouldRaiseWithExceptionDo (in category 'test') ----- testNoExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #noExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. ! Item was changed: + ----- Method: SUnitExtensionsTest>>testNoExceptionWithMatchingString (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testNoExceptionWithMatchingString (in category 'as yet unclassified') ----- testNoExceptionWithMatchingString self shouldnt: [ Object obsolete ] raise: Error whoseDescriptionIncludes: 'Zero' description: 'tested obsoleting Object'! Item was changed: + ----- Method: SUnitExtensionsTest>>testNoExceptionWithNoMatchingString (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testNoExceptionWithNoMatchingString (in category 'as yet unclassified') ----- testNoExceptionWithNoMatchingString self shouldnt: [ Object obsolete ] raise: Error whoseDescriptionDoesNotInclude: 'NOT' description: 'tested obsoleting Object'! Item was changed: + ----- Method: SUnitExtensionsTest>>testShouldFix (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testShouldFix (in category 'test') ----- testShouldFix | testCase testResult | testCase := self class selector: #shouldFixTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size=1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty. ! Item was changed: + ----- Method: SUnitExtensionsTest>>testShouldRaiseWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testShouldRaiseWithExceptionDo (in category 'test') ----- testShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #shouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size=1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty. ! Item was changed: + ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThan (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThan (in category 'test') ----- testValidShouldNotTakeMoreThan | testCase testResult | testCase := self class selector: #validShouldNotTakeMoreThan. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size = 1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty ! Item was changed: + ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThanMilliseconds (in category 'tests') ----- - ----- Method: SUnitExtensionsTest>>testValidShouldNotTakeMoreThanMilliseconds (in category 'test') ----- testValidShouldNotTakeMoreThanMilliseconds | testCase testResult | testCase := self class selector: #validShouldNotTakeMoreThanMilliseconds. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size = 1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty ! Item was changed: + ----- Method: SUnitTest>>errorShouldntRaise (in category 'tests') ----- - ----- Method: SUnitTest>>errorShouldntRaise (in category 'testing') ----- errorShouldntRaise self shouldnt: [self someMessageThatIsntUnderstood] raise: Notification new ! Item was changed: + ----- Method: SUnitTest>>testAssert (in category 'tests') ----- - ----- Method: SUnitTest>>testAssert (in category 'testing') ----- testAssert self assert: true. self deny: false ! Item was changed: + ----- Method: SUnitTest>>testAssertIdentical (in category 'tests') ----- - ----- Method: SUnitTest>>testAssertIdentical (in category 'testing') ----- testAssertIdentical | a b | a := 'foo'. b := 'bar'. self should: [self assert: a identical: b] raise: TestFailure. [self assert: a identical: b] on: TestFailure do: [:e | |error| error := e messageText. self assert: (error includesSubstring: a) description: 'Error message doesn''t include the expected value'. self assert: (error includesSubstring: b) description: 'Error message doesn''t include the expected value'].! Item was changed: + ----- Method: SUnitTest>>testAssertIdenticalDescription (in category 'tests') ----- - ----- Method: SUnitTest>>testAssertIdenticalDescription (in category 'testing') ----- testAssertIdenticalDescription | a b | a := 'foo'. b := a copy. self should: [self assert: a identical: b description: 'A desciption'] raise: TestFailure. [self assert: a identical: b description: 'A desciption'] on: TestFailure do: [:e | |error| error := e messageText. self assert: (error includesSubstring: 'A desciption') description: 'Error message doesn''t give you the description'].! Item was changed: + ----- Method: SUnitTest>>testAssertIdenticalWithEqualObjects (in category 'tests') ----- - ----- Method: SUnitTest>>testAssertIdenticalWithEqualObjects (in category 'testing') ----- testAssertIdenticalWithEqualObjects | a b | a := 'foo'. b := a copy. self should: [self assert: a identical: b] raise: TestFailure. [self assert: a identical: b] on: TestFailure do: [:e | |error| error := e messageText. self assert: (error includesSubstring: 'not identical') description: 'Error message doesn''t say the two things aren''t identical'].! Item was changed: + ----- Method: SUnitTest>>testDefects (in category 'tests') ----- - ----- Method: SUnitTest>>testDefects (in category 'testing') ----- testDefects | result suite error failure | suite := TestSuite new. suite addTest: (error := self class selector: #error). suite addTest: (failure := self class selector: #fail). result := suite run. self assert: result defects asArray = (Array with: error with: failure). self assertForTestResult: result runCount: 2 passed: 0 failed: 1 errors: 1 ! Item was changed: + ----- Method: SUnitTest>>testDialectLocalizedException (in category 'tests') ----- - ----- Method: SUnitTest>>testDialectLocalizedException (in category 'testing') ----- testDialectLocalizedException self should: [TestResult signalFailureWith: 'Foo'] raise: TestResult failure. self should: [TestResult signalErrorWith: 'Foo'] raise: TestResult error. ! Item was changed: + ----- Method: SUnitTest>>testError (in category 'tests') ----- - ----- Method: SUnitTest>>testError (in category 'testing') ----- testError | case result | case := self class selector: #error. result := case run. self assertForTestResult: result runCount: 1 passed: 0 failed: 0 errors: 1. case := self class selector: #errorShouldntRaise. result := case run. self assertForTestResult: result runCount: 1 passed: 0 failed: 0 errors: 1 ! Item was changed: + ----- Method: SUnitTest>>testException (in category 'tests') ----- - ----- Method: SUnitTest>>testException (in category 'testing') ----- testException self should: [self error: 'foo'] raise: TestResult error ! Item was changed: + ----- Method: SUnitTest>>testFail (in category 'tests') ----- - ----- Method: SUnitTest>>testFail (in category 'testing') ----- testFail | case result | case := self class selector: #fail. result := case run. self assertForTestResult: result runCount: 1 passed: 0 failed: 1 errors: 0 ! Item was changed: + ----- Method: SUnitTest>>testRan (in category 'tests') ----- - ----- Method: SUnitTest>>testRan (in category 'testing') ----- testRan | case | case := self class selector: #setRun. case run. self assert: case hasSetup. self assert: case hasRun ! Item was changed: + ----- Method: SUnitTest>>testRanOnlyOnce (in category 'tests') ----- - ----- Method: SUnitTest>>testRanOnlyOnce (in category 'testing') ----- testRanOnlyOnce self assert: hasRanOnce ~= true. hasRanOnce := true ! Item was changed: + ----- Method: SUnitTest>>testResult (in category 'tests') ----- - ----- Method: SUnitTest>>testResult (in category 'testing') ----- testResult | case result | case := self class selector: #noop. result := case run. self assertForTestResult: result runCount: 1 passed: 1 failed: 0 errors: 0 ! Item was changed: + ----- Method: SUnitTest>>testRunning (in category 'tests') ----- - ----- Method: SUnitTest>>testRunning (in category 'testing') ----- testRunning (Delay forSeconds: 2) wait ! Item was changed: + ----- Method: SUnitTest>>testSelectorWithArg: (in category 'tests') ----- - ----- Method: SUnitTest>>testSelectorWithArg: (in category 'testing') ----- testSelectorWithArg: anObject "should not result in error"! Item was changed: + ----- Method: SUnitTest>>testShould (in category 'tests') ----- - ----- Method: SUnitTest>>testShould (in category 'testing') ----- testShould self should: [true]; shouldnt: [false] ! Item was changed: + ----- Method: SUnitTest>>testSuite (in category 'tests') ----- - ----- Method: SUnitTest>>testSuite (in category 'testing') ----- testSuite | suite result | suite := TestSuite new. suite addTest: (self class selector: #noop); addTest: (self class selector: #fail); addTest: (self class selector: #error). result := suite run. self assertForTestResult: result runCount: 3 passed: 1 failed: 1 errors: 1 ! Item was changed: + ----- Method: SUnitTest>>testTestTimeout (in category 'tests') ----- - ----- Method: SUnitTest>>testTestTimeout (in category 'testing') ----- testTestTimeout self should:[(Delay forSeconds: (self timeoutForTest + 1)) wait] raise: TestFailure. ! Item was changed: + ----- Method: SUnitTest>>testTestTimeoutLoop (in category 'tests') ----- - ----- Method: SUnitTest>>testTestTimeoutLoop (in category 'testing') ----- testTestTimeoutLoop <timeout: 1> self should:[[] repeat] raise: TestFailure. ! Item was changed: + ----- Method: SUnitTest>>testTestTimeoutTag (in category 'tests') ----- - ----- Method: SUnitTest>>testTestTimeoutTag (in category 'testing') ----- testTestTimeoutTag <timeout: 1> self should:[(Delay forSeconds: 3) wait] raise: TestFailure. ! Item was changed: + ----- Method: SUnitTest>>testWithExceptionDo (in category 'tests') ----- - ----- Method: SUnitTest>>testWithExceptionDo (in category 'testing') ----- testWithExceptionDo self should: [self error: 'foo'] raise: TestResult error withExceptionDo: [:exception | self assert: (exception description includesSubstring: 'foo') ] ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>dummy (in category 'private') ----- - ----- Method: SimpleTestResourceTestCase>>dummy (in category 'not categorized') ----- dummy self assert: true ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>error (in category 'extensions') ----- - ----- Method: SimpleTestResourceTestCase>>error (in category 'not categorized') ----- error 'foo' odd ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>fail (in category 'extensions') ----- - ----- Method: SimpleTestResourceTestCase>>fail (in category 'not categorized') ----- fail self assert: false ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>setRun (in category 'extensions') ----- - ----- Method: SimpleTestResourceTestCase>>setRun (in category 'not categorized') ----- setRun resource setRun ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>setUp (in category 'running') ----- - ----- Method: SimpleTestResourceTestCase>>setUp (in category 'not categorized') ----- setUp resource := SimpleTestResource current ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>testRan (in category 'tests') ----- - ----- Method: SimpleTestResourceTestCase>>testRan (in category 'not categorized') ----- testRan | case | case := self class selector: #setRun. case run. self assert: resource hasSetup. self assert: resource hasRun ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>testResourceInitRelease (in category 'tests') ----- - ----- Method: SimpleTestResourceTestCase>>testResourceInitRelease (in category 'not categorized') ----- testResourceInitRelease | result suite error failure | suite := TestSuite new. suite addTest: (error := self class selector: #error). suite addTest: (failure := self class selector: #fail). suite addTest: (self class selector: #dummy). result := suite run. self assert: resource hasSetup ! Item was changed: + ----- Method: SimpleTestResourceTestCase>>testResourcesCollection (in category 'tests') ----- - ----- Method: SimpleTestResourceTestCase>>testResourcesCollection (in category 'not categorized') ----- testResourcesCollection | collection | collection := self resources. self assert: collection size = 1 ! Item was changed: + ----- Method: TestCase class>>testSelectors (in category 'accessing') ----- - ----- Method: TestCase class>>testSelectors (in category 'Accessing') ----- testSelectors ^(self selectors asArray select: [ :each | (each beginsWith: 'test') and: [ each numArgs isZero ] ]) sort! Item was changed: + ----- Method: TestCase>>expectedFailures (in category 'failures') ----- - ----- Method: TestCase>>expectedFailures (in category 'testing') ----- expectedFailures ^ Array new!

1 0

The Trunk: WebClient-Tests-pre.58.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of WebClient-Tests to project The Trunk: http://source.squeak.org/trunk/WebClient-Tests-pre.58.mcz ==================== Summary ==================== Name: WebClient-Tests-pre.58 Author: pre Time: 30 April 2019, 7:08:57.816906 pm UUID: e3079bfa-808e-204f-9484-ca955f8848d5 Ancestors: WebClient-Tests-pre.57 Fixes a test which does not deal well with time precision beyond a second. =============== Diff against WebClient-Tests-pre.57 =============== Item was changed: ----- Method: WebClientServerTest>>testCookieExpiryParsing (in category 'tests - cookies') ----- testCookieExpiryParsing "Test parsing of cookie expiry dates" | exp a b | + exp := DateAndTime today. - exp := DateAndTime date: Date today time: Time now. a := WebCookie new. a name: 'test'. a expiry: exp. b := WebCookie new readFrom: a asString readStream. self assert: b expiry = exp asUTC. b := WebCookie new readFrom: (a asString copyReplaceAll: '-' with: ' ') readStream. self assert: b expiry = exp asUTC. !

1 0

The Trunk: WebClient-Tests-pre.57.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of WebClient-Tests to project The Trunk: http://source.squeak.org/trunk/WebClient-Tests-pre.57.mcz ==================== Summary ==================== Name: WebClient-Tests-pre.57 Author: pre Time: 30 April 2019, 7:02:07.214906 pm UUID: 74aaf80c-2790-c749-90c9-7ba162e1e812 Ancestors: WebClient-Tests-pre.56 Recategorizes some methods in WebClient-Tests =============== Diff against WebClient-Tests-pre.56 =============== Item was changed: + ----- Method: WebClientServerTest>>expectedFailures (in category 'failures') ----- - ----- Method: WebClientServerTest>>expectedFailures (in category 'setup') ----- expectedFailures "Some old versions of HTTPSocket are broken" ((HTTPSocket respondsTo: #httpRequestHandler:) or:[SystemVersion current version beginsWith: 'Pharo']) ifFalse:[^#(testMultipartFiles2)]. ^#()! Item was changed: + ----- Method: WebClientServerTest>>localHostUrl (in category 'private') ----- - ----- Method: WebClientServerTest>>localHostUrl (in category 'setup') ----- localHostUrl ^'http://localhost:', self port asString! Item was changed: + ----- Method: WebClientServerTest>>port (in category 'private') ----- - ----- Method: WebClientServerTest>>port (in category 'setup') ----- port "Use a random port to minimise chances of concurrently running test suites clashing." ^ port ifNil: [port := (10000 to: 50000) atRandom]! Item was changed: + ----- Method: WebClientServerTest>>setUp (in category 'running') ----- - ----- Method: WebClientServerTest>>setUp (in category 'setup') ----- setUp server := WebServer new listenOn: self port. server passwordAt: 'user' realm: 'test' put: 'pass'. server addToken: 'shushitsissupersecret' toRealm: 'test'.! Item was changed: + ----- Method: WebClientServerTest>>tearDown (in category 'running') ----- - ----- Method: WebClientServerTest>>tearDown (in category 'setup') ----- tearDown server ifNotNil:[server destroy]. ! Item was added: + ----- Method: WebClientServerTest>>testMultipleRequestsInOneInstance (in category 'tests - requests') ----- + testMultipleRequestsInOneInstance + + | resp semaphore client | + semaphore := Semaphore new. + server addService: '/endpoint' action:[:req | + req send200Response: 'ok'. + semaphore signal]. + + client := WebClient new. + 1 to: 10 do: [:i | + resp := client httpGet: self localHostUrl, '/endpoint' do: [ :request | + request + headerAt: 'Connection' put: 'Keep-Alive'; + headerAt: 'Accept' put: '*/*' ]. + semaphore wait. + self assert: resp code = 200.]!

1 0

The Trunk: Tests-pre.410.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.410.mcz ==================== Summary ==================== Name: Tests-pre.410 Author: pre Time: 30 April 2019, 6:59:05.800906 pm UUID: d17c6b3c-0c13-2544-8c34-7f11ac74c762 Ancestors: Tests-eem.409 Recategorizes test methods and expected failure methods into tests and failures categories. =============== Diff against Tests-eem.409 =============== Item was changed: SystemOrganization addCategory: #'Tests-Bugs'! SystemOrganization addCategory: #'Tests-Compiler'! SystemOrganization addCategory: #'Tests-Dependencies'! SystemOrganization addCategory: #'Tests-Digital Signatures'! SystemOrganization addCategory: #'Tests-Environments'! SystemOrganization addCategory: #'Tests-Exceptions'! SystemOrganization addCategory: #'Tests-FilePackage'! SystemOrganization addCategory: #'Tests-Files'! SystemOrganization addCategory: #'Tests-Finalization'! SystemOrganization addCategory: #'Tests-Hex'! SystemOrganization addCategory: #'Tests-Installer-Core'! SystemOrganization addCategory: #'Tests-Localization'! SystemOrganization addCategory: #'Tests-Monticello'! SystemOrganization addCategory: #'Tests-Monticello-Mocks'! SystemOrganization addCategory: #'Tests-Monticello-Utils'! SystemOrganization addCategory: #'Tests-Object Events'! SystemOrganization addCategory: #'Tests-ObjectsAsMethods'! SystemOrganization addCategory: #'Tests-PrimCallController'! SystemOrganization addCategory: #'Tests-Release'! + SystemOrganization addCategory: #'Tests-System-Applications'! SystemOrganization addCategory: #'Tests-System-Digital Signatures'! SystemOrganization addCategory: #'Tests-System-Object Storage'! SystemOrganization addCategory: #'Tests-System-Preferences'! SystemOrganization addCategory: #'Tests-System-Support'! SystemOrganization addCategory: #'Tests-Utilities'! SystemOrganization addCategory: #'Tests-VM'! - SystemOrganization addCategory: #'Tests-System-Applications'! - SystemOrganization addCategory: #'Tests-MonticelloMocks'! Item was changed: + ----- Method: ArrayLiteralTest>>tearDown (in category 'running') ----- - ----- Method: ArrayLiteralTest>>tearDown (in category 'initialize-release') ----- tearDown self class removeSelector: #array! Item was changed: + ----- Method: BecomeTest>>testBecome (in category 'tests') ----- - ----- Method: BecomeTest>>testBecome (in category 'Testing') ----- testBecome "Test the two way become. Note. we cannot use string literals for this test" | a b c d | a := 'ab' copy. b := 'cd' copy. c := a. d := b. a become: b. self assert: a = 'cd'; assert: b = 'ab'; assert: c = 'cd'; assert: d = 'ab'. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForward (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForward (in category 'Testing') ----- testBecomeForward "Test the forward become." | a b c d | a := 'ab' copy. b := 'cd' copy. c := a. d := b. a becomeForward: b. self assert: a = 'cd'; assert: b = 'cd'; assert: c = 'cd'; assert: d = 'cd'. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardDontCopyIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardDontCopyIdentityHash (in category 'Testing') ----- testBecomeForwardDontCopyIdentityHash "Check that 1. the argument to becomeForward: is NOT modified to have the receiver's identity hash. 2. the receiver's identity hash is unchanged." | a b hb | a := 'ab' copy. b := 'cd' copy. hb := b identityHash. a becomeForward: b copyHash: false. self assert: a identityHash = hb; assert: b identityHash = hb. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardHash (in category 'Testing') ----- testBecomeForwardHash | a b c hb | a := 'ab' copy. b := 'cd' copy. c := a. hb := b hash. a becomeForward: b. self assert: a hash = hb; assert: b hash = hb; assert: c hash = hb. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardIdentityHash (in category 'Testing') ----- testBecomeForwardIdentityHash "Check that 1. the argument to becomeForward: is modified to have the receiver's identity hash. 2. the receiver's identity hash is unchanged." | a b ha | a := 'ab' copy. b := 'cd' copy. ha := a identityHash. a becomeForward: b. self assert: a identityHash = ha; assert: b identityHash = ha. ! Item was changed: + ----- Method: BecomeTest>>testBecomeHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeHash (in category 'Testing') ----- testBecomeHash | a b c d ha hb | a := 'ab' copy. b := 'cd' copy. c := a. d := b. ha := a hash. hb := b hash. a become: b. self assert: a hash = hb; assert: b hash = ha; assert: c hash = hb; assert: d hash = ha. ! Item was changed: + ----- Method: BecomeTest>>testBecomeIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeIdentityHash (in category 'Testing') ----- testBecomeIdentityHash | a b c d numberOfRetry newAIdentityHash newBIdentityHash oldAIdentityHash oldBIdentityHash | numberOfRetry := 0. [a := 'ab' copy. c := IdentitySet new: 1000. b := 'cd' copy. d := IdentitySet new: 1000. "Note: the sets are allocated with enough room to reduce probability that two different hash lead to same slot" "Note2: a & b creation are interleaved with c & d, because some VM allocate the same identityHash for two consecutively created objects" c add: a; add: b. d add: a. oldAIdentityHash := a identityHash. oldBIdentityHash := b identityHash. oldAIdentityHash = oldBIdentityHash and: [numberOfRetry < 10]] whileTrue: [numberOfRetry := numberOfRetry + 1]. self assert: oldAIdentityHash ~= oldBIdentityHash description: 'The VM is spawning too many equal identityHash to be honest'. a become: b. newAIdentityHash := a identityHash. newBIdentityHash := b identityHash. self "The set c & d can still retrieve their elements because elements did not change their expected position" assert: (c includes: a); assert: (c includes: b); assert: (d includes: a); deny: (d includes: b); "Elements didn't change their expected position because identityHash did not change" assert: oldAIdentityHash = newAIdentityHash; assert: oldBIdentityHash = newBIdentityHash! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testBlockTemporaries (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testBlockTemporaries (in category 'testing') ----- testBlockTemporaries | someCode someOtherCode | someCode := 'test | temp | [ | foo | ]'. someOtherCode := 'test | temp | [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo'). someCode := 'test [ | foo | ]'. someOtherCode := 'test [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo'). someCode := 'test | temp | [ | foo | ]'. someOtherCode := 'test [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo' 'temp').! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testComplex (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testComplex (in category 'testing') ----- testComplex | someCode someOtherCode | someCode := 'removeUnusedTemps: methodNode "Scan for unused temp names, and prompt the user about the prospect of removing each one found" | madeChanges tempsMarkHolder unusedTempNames tempMarkHoldersToChange encoder requestor| encoder := requestor := 1. madeChanges := false. tempMarkHoldersToChange := OrderedCollection new. tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. unusedTempNames := encoder unusedTempNames select: [ :temp | (encoder lookupVariable: temp ifAbsent: [ ]) isUndefTemp and: [ UnusedVariable name: temp ]]. tempsMarkHolder do: [ :currentBlock | || tempMarkHoldersToChange add: currentBlock. unusedTempNames do: [ :temp || someAdditionalTemps | (self removeUnusedTemporaryNamed: temp from: requestor text asString lookingAt: currentBlock movingTempMarksOf: tempMarkHoldersToChange) ifTrue: [ madeChanges := true ]]]. madeChanges ifTrue: [ self removeEmptyTempDeclarationsFrom: methodNode. ReparseAfterSourceEditing signal ]'. someOtherCode := 'removeUnusedTemps: methodNode "Scan for unused temp names, and prompt the user about the prospect of removing each one found" | madeChanges tempsMarkHolder unusedTempNames tempMarkHoldersToChange encoder requestor| encoder := requestor := 1. madeChanges := false. tempMarkHoldersToChange := OrderedCollection new. tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. unusedTempNames := encoder unusedTempNames select: [ :temp | (encoder lookupVariable: temp ifAbsent: [ ]) isUndefTemp and: [ UnusedVariable name: temp ]]. tempsMarkHolder do: [ :currentBlock | tempMarkHoldersToChange add: currentBlock. unusedTempNames do: [ :temp | (self removeUnusedTemporaryNamed: temp from: requestor text asString lookingAt: currentBlock movingTempMarksOf: tempMarkHoldersToChange) ifTrue: [ madeChanges := true ]]]. madeChanges ifTrue: [ self removeEmptyTempDeclarationsFrom: methodNode. ReparseAfterSourceEditing signal ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('someAdditionalTemps')! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testRegression (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testRegression (in category 'testing') ----- testRegression | someCode someOtherCode | someCode := 'test | temp |'. someOtherCode := 'test '. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('temp'). someCode := 'test | temp |'. someOtherCode := 'test | temp |'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #(). someCode := 'test | temp temptemp |'. someOtherCode := 'test | temp |'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('temptemp'). ! Item was changed: + ----- Method: ClosureTests>>methodArgument: (in category 'tests') ----- - ----- Method: ClosureTests>>methodArgument: (in category 'testing') ----- methodArgument: anObject ^ [ anObject ] ! Item was changed: + ----- Method: ClosureTests>>testBlockArgument (in category 'tests') ----- - ----- Method: ClosureTests>>testBlockArgument (in category 'testing') ----- testBlockArgument | block block1 block2 | block := [ :arg | | temp | temp := arg. [ temp ] ]. block1 := block value: 1. block2 := block value: 2. self assert: block1 value = 1. self assert: block2 value = 2! Item was changed: + ----- Method: ClosureTests>>testBlockTemp (in category 'tests') ----- - ----- Method: ClosureTests>>testBlockTemp (in category 'testing') ----- testBlockTemp | block block1 block2 | block := [ :arg | [ arg ] ]. block1 := block value: 1. block2 := block value: 2. self assert: block1 value = 1. self assert: block2 value = 2! Item was changed: + ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'tests') ----- - ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'testing') ----- testCopyNonLocalReturn "This should not fail." self methodWithNonLocalReturn! Item was changed: + ----- Method: ClosureTests>>testIsClean (in category 'tests') ----- - ----- Method: ClosureTests>>testIsClean (in category 'testing') ----- testIsClean | local | local := #testIsClean. self assert: [] isClean. "closes over nothing at all" self assert: [:a :b| a < b] isClean. "accesses only arguments" self assert: [:a :b| | s | s := a + b. s even] isClean. "accesses only local variables" self deny: [^nil] isClean. "closes over home (^-return)" self deny: [self] isClean. "closes over the receiver" self deny: [collection] isClean. "closes over the receiver (to access the inst var collection)" self deny: [local] isClean. "closes over local variable of outer context"! Item was changed: + ----- Method: ClosureTests>>testMethodArgument (in category 'tests') ----- - ----- Method: ClosureTests>>testMethodArgument (in category 'testing') ----- testMethodArgument | temp block | temp := 0. block := [ [ temp ] ]. temp := 1. block := block value. temp := 2. self assert: block value = 2! Item was changed: + ----- Method: ClosureTests>>testMethodTemp (in category 'tests') ----- - ----- Method: ClosureTests>>testMethodTemp (in category 'testing') ----- testMethodTemp | block1 block2 | block1 := self methodArgument: 1. block2 := self methodArgument: 2. self assert: block1 value = 1. self assert: block2 value = 2! Item was changed: + ----- Method: ClosureTests>>testToDoArgument (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoArgument (in category 'testing-todo') ----- testToDoArgument 1 to: 5 do: [ :index | collection add: [ index ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoArgumentNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoArgumentNotInlined (in category 'testing-todo') ----- testToDoArgumentNotInlined | block | block := [ :index | collection add: [ index ] ]. 1 to: 5 do: block. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoInsideTemp (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoInsideTemp (in category 'testing-todo') ----- testToDoInsideTemp 1 to: 5 do: [ :index | | temp | temp := index. collection add: [ temp ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoInsideTempNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoInsideTempNotInlined (in category 'testing-todo') ----- testToDoInsideTempNotInlined | block | block := [ :index | | temp | temp := index. collection add: [ temp ] ]. 1 to: 5 do: block. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoOutsideTemp (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoOutsideTemp (in category 'testing-todo') ----- testToDoOutsideTemp | temp | 1 to: 5 do: [ :index | temp := index. collection add: [ temp ] ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testToDoOutsideTempNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoOutsideTempNotInlined (in category 'testing-todo') ----- testToDoOutsideTempNotInlined | block temp | block := [ :index | temp := index. collection add: [ temp ] ]. 1 to: 5 do: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationAfter (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationAfter (in category 'testing-while') ----- testWhileModificationAfter | index | index := 0. [ index < 5 ] whileTrue: [ collection add: [ index ]. index := index + 1 ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationAfterNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationAfterNotInlined (in category 'testing-while') ----- testWhileModificationAfterNotInlined | index block | index := 0. block := [ collection add: [ index ]. index := index + 1 ]. [ index < 5 ] whileTrue: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationBefore (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationBefore (in category 'testing-while') ----- testWhileModificationBefore | index | index := 0. [ index < 5 ] whileTrue: [ index := index + 1. collection add: [ index ] ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationBeforeNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationBeforeNotInlined (in category 'testing-while') ----- testWhileModificationBeforeNotInlined | index block | index := 0. block := [ index := index + 1. collection add: [ index ] ]. [ index < 5 ] whileTrue: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTemp (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTemp (in category 'testing-while') ----- testWhileWithTemp | index | index := 0. [ index < 5 ] whileTrue: [ | temp | temp := index := index + 1. collection add: [ temp ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTempIsNil (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTempIsNil (in category 'testing-while') ----- testWhileWithTempIsNil | index | index := 0. [ index < 5 ] whileTrue: [ | temp | collection add: temp. temp := index := index + 1. collection add: temp]. self assertValues: #(nil 1 nil 2 nil 3 nil 4 nil 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTempNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTempNotInlined (in category 'testing-while') ----- testWhileWithTempNotInlined | index block | index := 0. block := [ | temp | temp := index := index + 1. collection add: [ temp ] ]. [ index < 5 ] whileTrue: block. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: CompilerNotifyingTest>>expectedFailures (in category 'failures') ----- - ----- Method: CompilerNotifyingTest>>expectedFailures (in category 'accessing') ----- expectedFailures "For these tests, the Compiler does not insert the notification where it would be most informative." ^#( "Notifying before the literal (which can be a message send) would be more informative" testTooManyLiterals "Notifying right before the 16th argument would be informative" testTooManyArguments "Notifying before the extraneous argument in the right block woul be useful" testifTrueBlockWithArgument testCaseOtherwiseBlockWithArgument )! Item was changed: + ----- Method: CompilerNotifyingTest>>setUp (in category 'running') ----- - ----- Method: CompilerNotifyingTest>>setUp (in category 'initialize-release') ----- setUp failure := Object new.! Item was changed: + ----- Method: CompilerNotifyingTest>>testATempShadowingAnotherTemp (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testATempShadowingAnotherTemp (in category 'testing') ----- testATempShadowingAnotherTemp self setUpForErrorsIn: '| x | x := 1. ^[ | ` Name already used in this method ->`x | x ]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testAlltogether (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testAlltogether (in category 'testing') ----- testAlltogether "Initialize for all known error conditions. Note that the chunk to be evaluated are separated by %, and expected errors enclosed in back quotes." self setUpForErrorsIn: ' "First, the senders of #offEnd:" #` Unmatched bracket ->`[ 1 2 % #[ 1 2 ` 8-bit integer or right bracket expected ->`256 4]% $` A Character was expected ->`% 1+2 ` Unmatched comment quote ->`"unfinished comment% #` Unmatched parenthesis ->`( 1 2% #` Unmatched parenthesis ->`( 1 2 % ^nil printString , ` Unmatched string quote ->`''unfinished string% "Then, the senders of #expected:" 2r` a digit between 0 and 1 expected ->`3% | x | x := ` Expression expected ->`% [ :x : ` Argument name expected ->`1]% [ :x ` Vertical bar expected ->`x + 1 ]% [:x | 1 ` Period or right bracket expected ->`( 1 ) ]% { 1. 2` Period or right brace expected ->`% { 1. 2 ` Period or right brace expected ->`% { 1. 2 ` Period or right brace expected ->`3 % { 1. 2. ` Variable or expression or right brace expected ->`| x | % super yourself` Cascading not expected ->`; yourself% nil yourself; ` Cascade expected ->`^ 2% "#externalFunctionDeclaration is skipped, this cannot be evaluated" 1 to: ` Argument expected ->`:=% 1 +` Argument expected ->`% 1 + ` Argument expected ->`* 2 + 3% 1+(2 ` right parenthesis expected ->`. % 1 + 2 ` Nothing more expected ->`^nil% "#pattern:inContext: skipped, cannot be evaluated" "#pragmaLiteral: #pragmaSequence #pragmaStatement skipped, cannot be evaluated" ( ` expression expected ->`. 2 . )% ( 1 ` right parenthesis expected ->`. 2 . )% "#primitive:error: #primitive:module:error: skipped, cannot be evaluated" ^ ` Expression to return expected ->`. 1 + 2% [ ^1 ` End of block expected ->`2]% | x y ` Vertical bar expected ->`% [:z | | x y ` Vertical bar expected ->`]% 1` an integer greater than 1 as valid radix expected ->`r0'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testAssignmentOfSelf (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testAssignmentOfSelf (in category 'testing') ----- testAssignmentOfSelf self setUpForErrorsIn: '` Cannot store into ->`self := 1. ^self'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testCascadeInASuperSend (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testCascadeInASuperSend (in category 'testing') ----- testCascadeInASuperSend self setUpForErrorsIn: 'super yourself` Cascading not expected ->`; yourself'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testCaseOtherwiseBlockWithArgument (in category 'tests - block arguments') ----- - ----- Method: CompilerNotifyingTest>>testCaseOtherwiseBlockWithArgument (in category 'testing-block arguments') ----- testCaseOtherwiseBlockWithArgument self setUpForErrorsIn: 'nil caseOf: { [nil] -> [1] } otherwise: [:x` <- otherwise arg of caseOf:otherwise: has too many arguments ->` | 2 ]. ^nil '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testDigitTooLargeForARadix (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testDigitTooLargeForARadix (in category 'testing') ----- testDigitTooLargeForARadix self setUpForErrorsIn: '2r` a digit between 0 and 1 expected ->`3'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testEmptyCaseStatement (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testEmptyCaseStatement (in category 'testing') ----- testEmptyCaseStatement self setUpForErrorsIn: '^ nil caseOf: { ` At least one case required ->`} '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testExpectedExpressionInBraceArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testExpectedExpressionInBraceArray (in category 'testing') ----- testExpectedExpressionInBraceArray self setUpForErrorsIn: '{ 1. 2 ` Period or right brace expected ->`3 }'. self enumerateAllSelections. self setUpForErrorsIn: '{ 1. 2. ` Variable or expression or right brace expected ->`| x | x}'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testExtraneousStatementAfterAReturnInABlock (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testExtraneousStatementAfterAReturnInABlock (in category 'testing') ----- testExtraneousStatementAfterAReturnInABlock self setUpForErrorsIn: '[ ^1 ` End of block expected ->`2]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidExternalFunctionDeclaration (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidExternalFunctionDeclaration (in category 'testing') ----- testInvalidExternalFunctionDeclaration "Not implemented yet. #externalFunctionDeclaration skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidLiteralCharacter (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidLiteralCharacter (in category 'testing') ----- testInvalidLiteralCharacter self setUpForErrorsIn: '^ #yourself , #` Invalid literal character ->`) , #end'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPattern (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPattern (in category 'testing') ----- testInvalidPattern "Not implemented yet. #pattern:inContext: skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPragma (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPragma (in category 'testing') ----- testInvalidPragma "Not implemented yet. #pragmaLiteral: #pragmaSequence #pragmaStatement #pragmaPrimitives skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPrimitive (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPrimitive (in category 'testing') ----- testInvalidPrimitive "Not implemented yet. ##primitive:error: #primitive:module:error: skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidRadix (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidRadix (in category 'testing') ----- testInvalidRadix self setUpForErrorsIn: '1` an integer greater than 1 as valid radix expected ->`r0'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testLiteralCharacterMissing (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testLiteralCharacterMissing (in category 'testing') ----- testLiteralCharacterMissing self setUpForErrorsIn: '$` A Character was expected ->`'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterABinaryMessage (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterABinaryMessage (in category 'testing') ----- testMissingArgumentAfterABinaryMessage self setUpForErrorsIn: '1 +` Argument expected ->`'. self enumerateAllSelections. self setUpForErrorsIn: '1 + ` Argument expected ->`* 2 + 3'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterAMessageKey (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterAMessageKey (in category 'testing') ----- testMissingArgumentAfterAMessageKey self setUpForErrorsIn: '1 to: ` Argument expected ->`:='. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingBlockArgumentName (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingBlockArgumentName (in category 'testing') ----- testMissingBlockArgumentName self setUpForErrorsIn: '[ :x : ` Argument name expected ->`1]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingExpression (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingExpression (in category 'testing') ----- testMissingExpression self setUpForErrorsIn: '| x | x := ` Expression expected ->'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingExpressionAfterAReturn (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingExpressionAfterAReturn (in category 'testing') ----- testMissingExpressionAfterAReturn self setUpForErrorsIn: '^ ` Expression to return expected ->`. 1 + 2'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingMessageAfterACascade (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingMessageAfterACascade (in category 'testing') ----- testMissingMessageAfterACascade self setUpForErrorsIn: 'nil yourself; ` Cascade expected ->`^ 2'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingPeriodSeparatorBetweenStatements (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingPeriodSeparatorBetweenStatements (in category 'testing') ----- testMissingPeriodSeparatorBetweenStatements self setUpForErrorsIn: '1 + 2 ` Nothing more expected ->`^nil'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingSeparatorBetweenBlockArgumentAndStatements (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingSeparatorBetweenBlockArgumentAndStatements (in category 'testing') ----- testMissingSeparatorBetweenBlockArgumentAndStatements self setUpForErrorsIn: '[ :x ` Vertical bar expected ->`x + 1 ]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTempDoubledDefined (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testTempDoubledDefined (in category 'testing') ----- testTempDoubledDefined self setUpForErrorsIn: '| x ` Name already used in this method ->`x | x := 1. ^x'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooLargeAnIntegerInALiteralByteArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testTooLargeAnIntegerInALiteralByteArray (in category 'testing') ----- testTooLargeAnIntegerInALiteralByteArray self setUpForErrorsIn: '#[ 1 2 ` 8-bit integer or right bracket expected ->`256 4 5]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyArguments (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyArguments (in category 'testing-byteCode limits') ----- testTooManyArguments self setUpForErrorsIn: '^[:x1 :x2 :x3 :x4 :x5 :x6 :x7 :x8 :x9 :x10 :x11 :x12 :x13 :x14 :x15 ` Too many arguments ->`:x16 :x17 | ]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyLiterals (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyLiterals (in category 'testing-byteCode limits') ----- testTooManyLiterals self setUpForErrorsIn: '{#(1). #(2). #(3). #(4). #(5). #(6). #(7). #(8). #(9). #(10). #(11). #(12). #(13). #(14). #(15). #(16). #(17). #(18). #(19). #(20). #(21). #(22). #(23). #(24). #(25). #(26). #(27). #(28). #(29). #(30). #(31). #(32). #(33). #(34). #(35). #(36). #(37). #(38). #(39). #(40). #(41). #(42). #(43). #(44). #(45). #(46). #(47). #(48). #(49). #(50). #(51). #(52). #(53). #(54). #(55). #(56). #(57). #(58). #(59). #(60). #(61). #(62). #(63). #(64). #(65). #(66). #(67). #(68). #(69). #(70). #(71). #(72). #(73). #(74). #(75). #(76). #(77). #(78). #(79). #(80). #(81). #(82). #(83). #(84). #(85). #(86). #(87). #(88). #(89). #(90). #(91). #(92). #(93). #(94). #(95). #(96). #(97). #(98). #(99). #(100). #(101). #(102). #(103). #(104). #(105). #(106). #(107). #(108). #(109). #(110). #(111). #(112). #(113). #(114). #(115). #(116). #(117). #(118). #(119). #(120). #(121). #(122). #(123). #(124). #(125). #(126). #(127). #(128). #(129). #(130). #(131). #(132). #(133). #(134). #(135) . #(136). #(137). #(138). #(139). #(140). #(141). #(142). #(143). #(144). #(145). #(146). #(147). #(148). #(149). #(150). #(151). #(152). #(153). #(154). #(155). #(156). #(157). #(158). #(159). #(160). #(161). #(162). #(163). #(164). #(165). #(166). #(167). #(168). #(169). #(170). #(171). #(172). #(173). #(174). #(175). #(176). #(177). #(178). #(179). #(180). #(181). #(182). #(183). #(184). #(185). #(186). #(187). #(188). #(189). #(190). #(191). #(192). #(193). #(194). #(195). #(196). #(197). #(198). #(199). #(200). #(201). #(202). #(203). #(204). #(205). #(206). #(207). #(208). #(209). #(210). #(211). #(212). #(213). #(214). #(215). #(216). #(217). #(218). #(219). #(220). #(221). #(222). #(223). #(224). #(225). #(226). #(227). #(228). #(229). #(230). #(231). #(232). #(233). #(234). #(235). #(236). #(237). #(238). #(239). #(240). #(241). #(242). #(243). #(244). #(245). #(246). #(247). #(248). #(249). #(250). #(251). #(252). #(253). #(254). #(255). #(256). `More than 256 literals ref erenced. You must split or otherwise simplify this method. The 257th literal is: ->`#(257)}'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyTemporaries (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyTemporaries (in category 'testing-byteCode limits') ----- testTooManyTemporaries "Nope, with Closure Compiler, an Error is raised before the Encoder has a chance to notify"! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedBlockBracket (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedBlockBracket (in category 'testing') ----- testUnmatchedBlockBracket self setUpForErrorsIn: 'nil yourself. [` Period or right bracket expected ->`'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedBraceArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedBraceArray (in category 'testing') ----- testUnmatchedBraceArray self setUpForErrorsIn: '{ 1. 2` Period or right brace expected ->`'. self enumerateAllSelections. self setUpForErrorsIn: '{ 1. 2 ` Period or right brace expected ->`'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedByteArrayBracket (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedByteArrayBracket (in category 'testing') ----- testUnmatchedByteArrayBracket self setUpForErrorsIn: '#` Unmatched bracket ->`[ 1 2 '. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedCommentQuote (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedCommentQuote (in category 'testing') ----- testUnmatchedCommentQuote self setUpForErrorsIn: '1+2 ` Unmatched comment quote ->`"unfinished comment'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedExpressionParenthesis (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedExpressionParenthesis (in category 'testing') ----- testUnmatchedExpressionParenthesis self setUpForErrorsIn: '1+(2 ` right parenthesis expected ->`. '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLiteralParenthesis (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLiteralParenthesis (in category 'testing') ----- testUnmatchedLiteralParenthesis self setUpForErrorsIn: '#` Unmatched parenthesis ->`( 1 2'. self enumerateAllSelections. self setUpForErrorsIn: '#` Unmatched parenthesis ->`( 1 2 '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclaration (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclaration (in category 'testing') ----- testUnmatchedLocalTempDeclaration self setUpForErrorsIn: '| x y ` Vertical bar expected ->`'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclarationInABlock (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclarationInABlock (in category 'testing') ----- testUnmatchedLocalTempDeclarationInABlock self setUpForErrorsIn: '[:z | | x y ` Vertical bar expected ->`]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedStringQuote (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedStringQuote (in category 'testing') ----- testUnmatchedStringQuote self setUpForErrorsIn: '^nil printString , ` Unmatched string quote ->`''unfinished string'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testifTrueBlockWithArgument (in category 'tests - block arguments') ----- - ----- Method: CompilerNotifyingTest>>testifTrueBlockWithArgument (in category 'testing-block arguments') ----- testifTrueBlockWithArgument self setUpForErrorsIn: 'true ifTrue: [:x` <- argument of ifTrue: has too many arguments ->` | 1 + 1 ]'. self enumerateAllSelections. self setUpForErrorsIn: 'true ifTrue: [:x` <- argument of ifTrue: has too many arguments ->` :y | 1 + 1 ]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInCollections (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInCollections (in category 'debugging') ----- testAllNodePCsAreForBytecodesInCollections <timeout: 30> "Approximately 2 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Collections! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInKernel (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInKernel (in category 'debugging') ----- testAllNodePCsAreForBytecodesInKernel <timeout: 30> "Approximately 3 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Kernel! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInMorphic (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInMorphic (in category 'debugging') ----- testAllNodePCsAreForBytecodesInMorphic <timeout: 30> "Approximately 6 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Morphic! Item was changed: + ----- Method: CompilerTest>>testBinarySelectorWithBar (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testBinarySelectorWithBar (in category 'syntax') ----- testBinarySelectorWithBar "Acknowledge the fact that $| is now allowed at any place in a binary selector" #(#'||' #'|||' #'|||++' #'<|>') do: [:selector | | source tree | source := ('1 ' , selector , ' 2') readStream. tree := (Compiler new) compileNoPattern: source in: Object notifying: nil ifFail: [nil]. self assert: tree notNil. "Hem, this test is really ugly..." self assert: tree block statements first expr selector key = selector].! Item was changed: + ----- Method: CompilerTest>>testBinarySelectorWithMinus (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testBinarySelectorWithMinus (in category 'syntax') ----- testBinarySelectorWithMinus "Acknowledge the fact that $- is now allowed at any place in a binary selector" | source tree | source := '1 @- 2' readStream. tree := (Compiler new) compileNoPattern: source in: Object notifying: nil ifFail: [nil]. self assert: tree notNil. "Hem, this test is really ugly..." self assert: tree block statements first expr selector key = #'@-'.! Item was changed: + ----- Method: CompilerTest>>testEmptyTemporaries (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testEmptyTemporaries (in category 'syntax') ----- testEmptyTemporaries self assert: (Compiler evaluate: '||') isNil! Item was changed: + ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'tests') ----- - ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'testing') ----- testEvaluationOfInlinedToDo "Whether inlined or not, #to:do: should return the same value" | inlinedResult notInlinedResult | inlinedResult := Compiler new evaluate: '1+1 to: 0 do: [:i | ]' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. notInlinedResult := Compiler new evaluate: '| aBlock | aBlock := [:i | ]. 1+1 to: 0 do: aBlock' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult = notInlinedResult. inlinedResult := Compiler new evaluate: '| stream results | stream := ReadStream on: #(2 1). results := OrderedCollection new. stream next to: stream next do: [ :i | results add: i ]. results' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult isEmpty. inlinedResult := Compiler new evaluate: '| stream results | stream := ReadStream on: #(1 2). results := OrderedCollection new. stream next to: stream next do: [ :i | results add: i ]. results' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult asArray = #(1 2)! Item was changed: + ----- Method: CompilerTest>>testInvalidVerticalBarSelector (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testInvalidVerticalBarSelector (in category 'syntax') ----- testInvalidVerticalBarSelector self should: [Compiler evaluate: '1 | | 2'] raise: SyntaxErrorNotification. self should: [Compiler evaluate: '1 | - 2'] raise: SyntaxErrorNotification.! Item was changed: + ----- Method: CompilerTest>>testLocalTemporariesInABlock (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testLocalTemporariesInABlock (in category 'syntax') ----- testLocalTemporariesInABlock self assert: ((Compiler evaluate: '[:x|| tmp | tmp := x]') value: 2) = 2! Item was changed: + ----- Method: CompilerTest>>testMaxLiterals (in category 'tests - limits') ----- - ----- Method: CompilerTest>>testMaxLiterals (in category 'limits') ----- testMaxLiterals "Document the maximum number of literals in a compiled method" | maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals | "Why 6? It's rather implementation dependent. But the {... construct is compiled as (Array braceStream: size) nextPut: expr; ...; braceArray where nextPut: is a special selector. So one each for Array binding, #braceStream, #braceArray and the size, one for the selector and one for the methodClass makes 6." maxLiterals := CompiledCode preferredBytecodeSetEncoderClass new maxNumLiterals - 6. stringThatCanBeCompiled := '{ ', (String streamContents: [:strm | 1 to: maxLiterals do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. stringWithOneTooManyLiterals := '{ ', (String streamContents: [:strm | 1 to: maxLiterals + 1 do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. self assert: ((1 to: maxLiterals) collect: #printString) equals: (Compiler evaluate: stringThatCanBeCompiled). "If the following test fails, it means that the limit has been raised or eliminated, and this test should be updated to reflect the improvement." self should: [Compiler evaluate: stringWithOneTooManyLiterals] raise: Error. ! Item was changed: + ----- Method: CompilerTest>>testNegativeNumbers (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testNegativeNumbers (in category 'syntax') ----- testNegativeNumbers "Acknowledge the fact that (- 2) which was accepted up to Squeak 3.10 is not valid anymore" self assert: (Compiler evaluate: '-2') = 2 negated. self should: [Compiler evaluate: '- 2'] raise: SyntaxErrorNotification description: 'A negative number literal shall not include any separator'! Item was changed: + ----- Method: CompilerTest>>testNegativeZero (in category 'tests - literals') ----- - ----- Method: CompilerTest>>testNegativeZero (in category 'literals') ----- testNegativeZero self assert: (Compiler evaluate: '-0.0') hex = Float negativeZero hex.! Item was changed: + ----- Method: CompilerTest>>testScaledDecimalLiterals (in category 'tests - literals') ----- - ----- Method: CompilerTest>>testScaledDecimalLiterals (in category 'literals') ----- testScaledDecimalLiterals "Equal ScaledDecimal with different scales should use different slots This is related to http://bugs.squeak.org/view.php?id=6797" "This correctly works when evaluated separately" self deny: (Compiler evaluate: '0.5s1') scale = (Compiler evaluate: '0.5s2') scale. "But not when evaluated together if literal reduction is too agressive" self deny: (Compiler evaluate: '0.5s1 scale = 0.5s2 scale').! Item was changed: + ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'tests') ----- - ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'testing') ----- testToDoModifiesTheLimit "This is a non regression test for http://bugs.squeak.org/view.php?id=7093. When blocks writes into to:do: loop limit, optimization shall be carried with care." self assert: 4 equals: [ | n | n := 2. 1 to: n do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value. self assert: 4 equals: [ | n | n := 2. 1 to: n by: 1 do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value. self assert: 4 equals: [ | n inc | n := 2. inc := 1. 1 to: n by: inc do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value.! Item was changed: + ----- Method: DecompilerTests>>expectedFailures (in category 'failures') ----- - ----- Method: DecompilerTests>>expectedFailures (in category 'testing') ----- expectedFailures ^ #(testDecompileUnreachableParameter)! Item was changed: + ----- Method: DecompilerTests>>tearDown (in category 'running') ----- - ----- Method: DecompilerTests>>tearDown (in category 'initialize-release') ----- tearDown self class removeSelector: #loopWithMovingLimit! Item was changed: + ----- Method: EnvironmentTest>>testAssociationsDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAssociationsDo (in category 'compatibility tests') ----- testAssociationsDo "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. env associationsDo: [:assoc | (#(Smalltalk Undeclared) includes: assoc key) ifFalse: ["We're not interested in these default bindings" self assert: (#(Griffle Plonk Nurp) includes: assoc key). self assert: value equals: assoc value]]. ! Item was changed: + ----- Method: EnvironmentTest>>testAtDoesntFindUndeclared (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testAtDoesntFindUndeclared (in category 'binding tests') ----- testAtDoesntFindUndeclared "It seems reasonable for #bindingOf: to answer either an existing binding, or create an undeclared binding and answer that. Reasonable, but wrong. The tools expect to receive nil if no binding exists, and explicitly create an undeclared binding if that's desirable." env := Environment withName: #Test. env bindingOf: #Griffle. self should: [ env at: #Griffle ] raise: KeyNotFound! Item was changed: + ----- Method: EnvironmentTest>>testAtIfAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfAbsent (in category 'compatibility tests') ----- testAtIfAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | result := env at: #Griffle ifAbsent: [value]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfAbsentNot (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfAbsentNot (in category 'compatibility tests') ----- testAtIfAbsentNot "For compatibility with legacy code, environments should implement the dictionary protocol." | result | env at: #Griffle put: value. result := env at: #Griffle ifAbsent: [self assert: false]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresent (in category 'compatibility tests') ----- testAtIfPresent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | env at: #Griffle put: value. env at: #Griffle ifPresent: [:v | result := v]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentAbsent (in category 'compatibility tests') ----- testAtIfPresentIfAbsentAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | answer result | result := Object new. answer := env at: #Griffle ifPresent: [:v | self fail: 'should not reach here'] ifAbsent: [result]. self assert: result identical: answer description: 'Method answers the result of the absent block'! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentPresent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentPresent (in category 'compatibility tests') ----- testAtIfPresentIfAbsentPresent "For compatibility with legacy code, environments should implement the dictionary protocol." | answer argument result | result := Object new. env at: #Griffle put: value. answer := env at: #Griffle ifPresent: [:v | argument := v. result] ifAbsent: [#absent]. self assert: value identical: argument description: 'Value is passed to the ifPresent block'. self assert: result identical: answer description: 'Method answers the result of the block'! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentNot (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentNot (in category 'compatibility tests') ----- testAtIfPresentNot "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle ifPresent: [self fail: 'should not reach here'].! Item was changed: + ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'compatibility tests') ----- testAtPutDeclared "For compatibility with legacy code, environments should implement the dictionary protocol." | binding | env bind: #Griffle to: Object new. binding := env associationAt: #Griffle. env at: #Griffle put: value. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testAtPutUndeclared (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtPutUndeclared (in category 'compatibility tests') ----- testAtPutUndeclared "For compatibility with legacy code, environments should implement the dictionary protocol." | binding | binding := env undeclare: #Griffle. env at: #Griffle put: value. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'compatibility tests') ----- testDeclaredBecomeClassBinding "If a global variable is assigned a class as its value, its binding will become a class binding." | binding class | class := Behavior new. binding := env bind: #Griffle to: value; declarationOf: #Griffle. env at: #Griffle put: class. self assert: (binding class == ClassBinding). self assert: binding value == class.! Item was changed: + ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'compatibility tests') ----- testDeclaredBecomeGlobal "If a class binding gets assigned a non- class value, the binding becomes a global." | binding class | class := Behavior new. binding := env bind: #Griffle to: class; declarationOf: #Griffle. env at: #Griffle put: value. self assert: (binding class == Global). self assert: binding value == value.! Item was changed: + ----- Method: EnvironmentTest>>testDestroyRemovesObservers (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyRemovesObservers (in category 'observation tests') ----- testDestroyRemovesObservers "When an imported environment is destroyed, the import is destroyed along with it." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. env import: foreign. foreign destroy. self assert: 0 equals: (env instVarNamed: 'policies') size! Item was changed: + ----- Method: EnvironmentTest>>testDestroyStopsObserving (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyStopsObserving (in category 'observation tests') ----- testDestroyStopsObserving "When an environment is destroyed, it removes its self from the observers list of other environments." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. env import: foreign. env destroy. self assert: 0 equals: (foreign instVarNamed: 'observers') size! Item was changed: + ----- Method: EnvironmentTest>>testDestroyedImportIsUndeclared (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyedImportIsUndeclared (in category 'observation tests') ----- testDestroyedImportIsUndeclared "When an imported environment is destroyed, it's bindings become undeclared in the importing environment" | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env from: foreign import: #Griffle. foreign destroy. self assert: (env bindingOf: #Griffle) isNil. self assert: (env isUndeclared: #Griffle).! Item was changed: + ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'export tests') ----- testExclusiveExplicitExport "Exporting one name shouldn't export others." env export: #Plonk. env at: #Griffle put: Object new. self denyExports: #Griffle! Item was changed: + ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'export tests') ----- testExclusiveMultiExplicitExport "Exporting multiple names shouldn't export a name not on the list." env export: #(Plonk #Griffle). env at: #Nurp put: Object new. self denyExports: #Nurp! Item was changed: + ----- Method: EnvironmentTest>>testExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExplicitExport (in category 'export tests') ----- testExplicitExport "Export a single name" env export: #Griffle. env bind: #Griffle to: value. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportAddPrefix (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportAddPrefix (in category 'export tests') ----- testExportAddPrefix "export all names, adding a prefix." env exportAddingPrefix: 'XX'. env at: #Griffle put: value. self assertExports: #XXGriffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportAddingPrefixPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportAddingPrefixPublicizesExistingValue (in category 'export tests') ----- testExportAddingPrefixPublicizesExistingValue "Export, adding prefix, *after* the binding has been created" env at: #Griffle put: value. env exportAddingPrefix: 'XX'. self assertExports: #XXGriffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportPublicizesExistingValue (in category 'export tests') ----- testExportPublicizesExistingValue "Export a single name, after the binding as been created." env at: #Griffle put: value. env export: #Griffle. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportRemovingPrefix (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportRemovingPrefix (in category 'export tests') ----- testExportRemovingPrefix "Export all names, removing a prefix" env exportRemovingPrefix: 'XX'. env at: #XXGriffle put: value. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportRemovingPrefixPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportRemovingPrefixPublicizesExistingValue (in category 'export tests') ----- testExportRemovingPrefixPublicizesExistingValue "Export all names, removing a prefix, after a binding has been created." env at: #XXGriffle put: value. env exportRemovingPrefix: 'XX'. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportSelfPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportSelfPublicizesExistingValue (in category 'export tests') ----- testExportSelfPublicizesExistingValue "Export all values, after a binding has been created." env at: #Griffle put: value. env exportSelf. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testImportAddingPrefix (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAddingPrefix (in category 'import tests') ----- testImportAddingPrefix "Import a single name adding a prefix." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env import: foreign addingPrefix: 'XX'. self assert: (env bindingOf: #XXGriffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'import tests') ----- testImportAddingPrefixResolvesUndeclared "If there's an existing undeclared variable, importing a binding with the same (transformed) name creates the binding." | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. binding := env undeclare: #XXGriffle. env import: foreign addingPrefix: 'XX'. self assert: (env bindingOf: #XXGriffle) == binding. self assert: (env valueOf: #XXGriffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAlias (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAlias (in category 'import tests') ----- testImportAlias | foreign binding | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. env from: foreign import: #Griffle -> #Plonk. binding := env bindingOf: #Plonk. self assert: binding key = #Plonk. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAliases (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAliases (in category 'import tests') ----- testImportAliases "Import several specific names, renaming them." | foreign v2 v3 | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. foreign at: #Nurp put: (v2 := Object new). foreign at: #Ziffy put: (v3 := Object new). env from: foreign import: {#Nurp -> #Plonk. #Ziffy -> #Wiffy}. self assert: (env bindingOf: #Griffle) isNil. self assert: (env bindingOf: #Plonk) value == v2. self assert: (env bindingOf: #Wiffy) value == v3! Item was changed: + ----- Method: EnvironmentTest>>testImportFromOther (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportFromOther (in category 'import tests') ----- testImportFromOther "Import a whole environment." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env import: foreign. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportOne (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportOne (in category 'import tests') ----- testImportOne "import s specific name" | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env from: foreign import: #Griffle. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportRemovingPrefix (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportRemovingPrefix (in category 'import tests') ----- testImportRemovingPrefix "Import all names, removing a prefix." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #XXGriffle put: value. env import: foreign removingPrefix: 'XX'. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'import tests') ----- testImportRemovingPrefixResolvesUndeclared "Import all names, removing a prefix, with undeclared" | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #XXGriffle put: value. binding := env undeclare: #Griffle. env import: foreign removingPrefix: 'XX'. self assert: (env bindingOf: #Griffle) == binding. self assert: (env valueOf: #Griffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportResolvesUndeclared (in category 'import tests') ----- testImportResolvesUndeclared "Import all bindings, with undeclared" | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. binding := env undeclare: #Griffle. env import: foreign. self assert: (env bindingOf: #Griffle) == binding. self assert: (env valueOf: #Griffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportWritable (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportWritable (in category 'import tests') ----- testImportWritable "Imported globals, even if renamed, should be writable." | foreign binding | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: 'v1'. env from: foreign import: #Griffle -> #Plonk. binding := env bindingOf: #Plonk. binding value: 'v2'. self assert: (foreign declarationOf: #Griffle) value = 'v2' ! Item was changed: + ----- Method: EnvironmentTest>>testInternalVisibility (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testInternalVisibility (in category 'compiling tests') ----- testInternalVisibility "A method on a class in an environment can refer to other classes in that environment (provided the environment imports its self)" | griffle plonk | env importSelf. self createClass: #Griffle. self createClass: #Plonk. griffle := env at: #Griffle. griffle compileSilently: 'plonk ^ Plonk'. plonk := griffle new plonk. self assert: (env at: #Plonk) == plonk! Item was changed: + ----- Method: EnvironmentTest>>testKeysAndValuesDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testKeysAndValuesDo (in category 'compatibility tests') ----- testKeysAndValuesDo "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. env keysAndValuesDo: [:key :val | (#(Smalltalk Undeclared) includes: key) ifFalse: ["We're not interested in these default bindings" self assert: (#(Griffle Plonk Nurp) includes: key). self assert: value equals: val]].! Item was changed: + ----- Method: EnvironmentTest>>testMultiExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testMultiExplicitExport (in category 'export tests') ----- testMultiExplicitExport "Export a list of names" | v2 | env export: #(#Griffle #Plonk). env at: #Griffle put: value. env at: #Plonk put: (v2 := Object new). self assertExports: #Griffle value: value. self assertExports: #Plonk value: v2! Item was changed: + ----- Method: EnvironmentTest>>testMultiExportPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testMultiExportPublicizesExistingValue (in category 'export tests') ----- testMultiExportPublicizesExistingValue "Export a list of names, with existing binaries." | v2 | env at: #Griffle put: value. env at: #Plonk put: (v2 := Object new). env export: #(Griffle Plonk). self assertExports: #Griffle value: value. self assertExports: #Plonk value: v2.! Item was changed: + ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'binding tests') ----- testReadOnlyBindings "It's almost always a bug to overwrite a class, so all class bindings should be read-only by default." | binding class | class := Behavior new. env importSelf. env bind: #Griffle to: class. binding := env bindingOf: #Griffle. self should: [binding value: nil] raise: AttemptToWriteReadOnlyGlobal! Item was changed: + ----- Method: EnvironmentTest>>testRemoveKey (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testRemoveKey (in category 'compatibility tests') ----- testRemoveKey "For compatibility with legacy code, environments should implement the dictionary protocol." self should: [env removeKey: #Griffle] raise: KeyNotFound.! Item was changed: + ----- Method: EnvironmentTest>>testRemoveKeyIfAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testRemoveKeyIfAbsent (in category 'compatibility tests') ----- testRemoveKeyIfAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | result := env removeKey: #Griffle ifAbsent: [#removed]. self assert: #removed equals: result. env at: #Griffle put: value. result := env removeKey: #Griffle ifAbsent: [#removed]. self assert: value equals: result.! Item was changed: + ----- Method: EnvironmentTest>>testRenameContinuity (in category 'tests - class') ----- - ----- Method: EnvironmentTest>>testRenameContinuity (in category 'class tests') ----- testRenameContinuity "When we rename a class, literal references to it from method bytecode should still work even though they are now undeclared." | class | env importSelf. class := self createClass: #Griffle. class compileSilently: 'foo ^ Griffle new' classified: ''. self shouldnt: [class new foo] raise: Error. self assert: class equals: class new foo class description: '<failsafe>'. class rename: #Plonk. self shouldnt: [class new foo] raise: Error. self assert: class equals: class new foo class description: 'The value of the binding should still be intact after a class rename'. ! Item was changed: + ----- Method: EnvironmentTest>>testRenameCreatesNewBinding (in category 'tests - class') ----- - ----- Method: EnvironmentTest>>testRenameCreatesNewBinding (in category 'class tests') ----- testRenameCreatesNewBinding "When we rename a class, a completely new binding should be created for the new name. The old binding is moved to undeclared." | class newBinding oldBinding | env importSelf. class := self createClass: #Griffle. oldBinding := env bindingOf: #Griffle. class rename: #Plonk. newBinding := env bindingOf: #Plonk. self deny: newBinding == oldBinding. self assert: class identical: oldBinding value. self assert: #Griffle equals: oldBinding key. self assert: #Plonk equals: newBinding key. self assert: class identical: newBinding value. ! Item was changed: + ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'export tests') ----- testRequireExplicitExports "Names that haven't been exported aren't visible, even if a binding exists." env bind: #Griffle to: Object new. self denyExports: #Griffle.! Item was changed: + ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'compiling tests') ----- testStoreDomesticValue "Create a class that implements #doStore. (see the comment in #storeValueMethod.) Send the message, then examine the results. The two values should be identical." | griffle values | env importSelf. env from: Smalltalk globals import: #Object. self createClass: #Griffle. env bind: #Plonk to: value. griffle := env at: #Griffle. griffle compileSilently: self storeValueMethod. values := griffle new doStore. self assert: values isArray. self assert: values size = 2. self assert: values first == values last. self assert: (env valueOf: #Plonk) == values first! Item was changed: + ----- Method: EnvironmentTest>>testStoreImportedValue (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testStoreImportedValue (in category 'compiling tests') ----- testStoreImportedValue "Create a class that implements #doStore. Import #Plonk from another environment. (see the comment in #storeValueMethod.) Send the message, then examine the results. The two values should be identical." | griffle foreign values | self createClass: #Griffle. foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Plonk put: 'v1'. env from: foreign import: #Plonk. env from: Smalltalk globals import: #Object. griffle := env at: #Griffle. griffle compileSilently: self storeValueMethod. values := griffle new doStore. self assert: values isArray. self assert: values size = 2. self assert: values first == values last. self assert: (foreign at: #Plonk) == values first! Item was changed: + ----- Method: EnvironmentTest>>testUnbindDoesNotAlterImportedBindings (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testUnbindDoesNotAlterImportedBindings (in category 'observation tests') ----- testUnbindDoesNotAlterImportedBindings "When attempting to unbind a symbol, do not alter bindings outside of the envrionments' own declarations." | foreign foreignBinding one two | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. foreignBinding := foreign associationAt: #Griffle. env at: #Griffle put: Object new. env importSelf. env import: foreign. one := env bindingOf: #Griffle. self assert: one == foreignBinding description: 'imported binding'. env unbind: #Griffle. two := env bindingOf: #Griffle. self assert: value equals: foreignBinding value description: 'imported value unaffacted'. self assert: two == foreignBinding description: 'imported binding still in place'.! Item was changed: + ----- Method: EnvironmentTest>>testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment (in category 'observation tests') ----- testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment "When a symbol is undeclared, the observing environments should not lose a binding with the same key if that binding is actually imported from self or a third environment." | foreign foreignBinding one ownValue two three | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. foreignBinding := foreign associationAt: #Griffle. env importSelf. env import: foreign. one := env bindingOf: #Griffle. self assert: one == foreignBinding description: 'imported binding'. self assert: one value == value description: 'imported binding'. ownValue := Object new. env bind: #Griffle to: ownValue. two := env bindingOf: #Griffle. self assert: one ~~ two description: 'new binding'. foreign unbind: #Griffle. self assert: nil equals: one value description: 'imported binding undeclared'. three := env bindingOf: #Griffle. self assert: two == three description: 'own binding unaffected'. self assert: three value == ownValue description: 'own binding''s value unaffected'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclare (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclare (in category 'binding tests') ----- testUndeclare "When a symbol is undeclared, it's not visible to methods compiled in the environment, so #bindingOf: should answer nil. However, methods that refer to the symbol anyway use a canonical binding. That binding should have a nil value and be an instance of Global, rather than a class binding or alias." | one two | one := env undeclare: #Griffle. two := env bindingOf: #Griffle. self assert: nil equals: two description: '#bindingOf:'. self assert: Global equals: one class description: 'Type of binding'. self assert: nil equals: one value description: 'Value of binding'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareAgain (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareAgain (in category 'binding tests') ----- testUndeclareAgain "Multiple 'undeclarations' of the same variable name should use the same canonical binding." | one two | one := env undeclare: #Griffle. two := env undeclare: #Griffle. self assert: one == two.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromConflict (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromConflict (in category 'binding tests') ----- testUndeclareFromConflict "When a shared variable is removed from a class pool, it gets undeclared in the environment. If that variable name is *already* undeclared in the environment, the binding in the environment is maintained, and references to the pool binding become references to the environment's binding. The binding should be a Global." | one pool three two | pool := IdentityDictionary new. pool at: #Griffle put: value. one := pool bindingOf: #Griffle. two := env undeclare: #Griffle. three := env undeclare: #Griffle from: pool. self assert: three == two description: 'Existing binding is reused'. self assert: three == one description: 'Pool binding is forwarded'. self assert: Global equals: three class description: 'Type of binding'. ! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromEmpty (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromEmpty (in category 'binding tests') ----- testUndeclareFromEmpty "When a binding is moved from a pool to an environment, but actually doesn't exist in the pool in the first place, a new binding with a nil value is created for the environment's undeclared dictionary." | binding | binding := env undeclare: #Griffle from: IdentityDictionary new. self assert: Global equals: binding class description: 'Type of binding'. self assert: nil equals: binding value description: 'Value of binding'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromRemovesOld (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromRemovesOld (in category 'binding tests') ----- testUndeclareFromRemovesOld "When a binding is removed from a pool, and undeclared in the enviornment, it should actually be removed from the pool dictionary." | pool | pool := IdentityDictionary new. pool at: #Griffle put: value. env undeclare: #Griffle from: pool. self assert: false equals: (pool includesKey: #Griffle) description: 'Existing binding is removed'. ! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'compatibility tests') ----- testUndeclaredBecomeClassBinding "When a undeclared name is bound to a class existing bindings are transformed into ClassBindings." | binding class | class := Behavior new. binding := env undeclare: #Griffle. env at: #Griffle put: class. self assert: (binding class == ClassBinding). self assert: binding value == class.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'compatibility tests') ----- testUndeclaredBecomesGlobal "If a class binding is somehow undeclared, it becomes a Global when a non-behavior value is bound to the name." | binding class | class := Behavior new. binding := env undeclared add: (#Griffle => class); associationAt: #Griffle. env bind: #Griffle to: value. self assert: (binding class == Global). self assert: binding value == value.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBindingMoved (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclaredBindingMoved (in category 'binding tests') ----- testUndeclaredBindingMoved "If a binding is undeclared, and subsequently declared, the existing binding is re-used for the declaration." | binding | binding := env undeclare: #Griffle. env bind: #Griffle to: value. self assert: (env declarationOf: #Griffle) = binding.! Item was changed: + ----- Method: EnvironmentTest>>testValuesDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testValuesDo (in category 'compatibility tests') ----- testValuesDo "For compatibility with legacy code, environments should implement the dictionary protocol." | count | env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. count := 0. env valuesDo: [:val | count := count + 1]. self assert: 3 + 2 equals: count description: '#valuesDo: should see all declared vallues plus the ones from Smalltalk and Undeclares' ! Item was changed: + ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'compatibility tests') ----- testWriteAndLookup "For compatibility with SystemDictionary, #at:put: should create a binding which can subsequently be found with #associationAt:." | binding | env at: #Griffle put: value. binding := env associationAt: #Griffle. self assert: binding key == #Griffle. self assert: binding value == value. ! Item was changed: + ----- Method: EnvironmentTest>>testWriteAndRead (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testWriteAndRead (in category 'compatibility tests') ----- testWriteAndRead "For compatibility with SystemDictionary, a value set with #at:put: should be retrievable with #at:" env at: #Griffle put: value. self assert: (env at: #Griffle) == value.! Item was changed: + ----- Method: ExceptionTests>>expectedFailures (in category 'failures') ----- - ----- Method: ExceptionTests>>expectedFailures (in category 'testing-outer') ----- expectedFailures "This test is a feature request. For more information on this issue visit: http://forum.world.st/The-Inbox-Tests-TestRunner-156-mcz-tc4643910.html#a46… http://forum.world.st/ExceptionTests-Wrong-error-handler-tc4848699.html http://forum.world.st/ExceptionTests-gt-testHandlerFromAction-fails-tc48728…" ^ #(testHandlerFromAction).! Item was changed: + ----- Method: ExceptionTests>>testDoubleOuterPass (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoubleOuterPass (in category 'testing-ExceptionTester') ----- testDoubleOuterPass self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) ! Item was changed: + ----- Method: ExceptionTests>>testDoublePassOuter (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoublePassOuter (in category 'testing-ExceptionTester') ----- testDoublePassOuter self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) ! Item was changed: + ----- Method: ExceptionTests>>testDoubleResume (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoubleResume (in category 'testing-ExceptionTester') ----- testDoubleResume self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) ! Item was changed: + ----- Method: ExceptionTests>>testHandlerFromAction (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testHandlerFromAction (in category 'testing-outer') ----- testHandlerFromAction "A test ensuring that nested exceptions work as expected." | result | result := [ [ [self error: 'trigger error'] on: ZeroDivide do: [ :ex | 'inner' ] ] on: Error do: [ :ex | 3 / 0 ] ] on: ZeroDivide do: [ :ex | 'outer' ]. self assert: 'outer' equals: result description: 'Incorrect handler'. ! Item was changed: + ----- Method: ExceptionTests>>testHandlerReentrancy (in category 'tests') ----- - ----- Method: ExceptionTests>>testHandlerReentrancy (in category 'testing') ----- testHandlerReentrancy | callingOrder | "Handlers are not re-entrant by default, so inner is not activated twice" callingOrder := String streamContents: [:stream | [[stream nextPut: $s. Notification signal] "Inner handler" on: Notification do: [:ex | stream nextPut: $i. ex pass]] "outer handler" on: Notification do: [:ex | stream nextPut: $o. Notification signal]]. self assert: callingOrder = 'sio'. "Now make inner re-entrant" callingOrder := String streamContents: [:stream | [[stream nextPut: $s. Notification signal] "Inner handler" on: Notification do: [:ex | stream nextPut: $i. ex rearmHandlerDuring: [ex pass]]] "outer handler" on: Notification do: [:ex | stream nextPut: $o. Notification signal]]. self assert: callingOrder = 'sioi'.! Item was changed: + ----- Method: ExceptionTests>>testNoTimeout (in category 'tests') ----- - ----- Method: ExceptionTests>>testNoTimeout (in category 'testing') ----- testNoTimeout self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) ! Item was changed: + ----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') ----- testNonResumableFallOffTheEndHandler self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) ! Item was changed: + ----- Method: ExceptionTests>>testNonResumableOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testNonResumableOuter (in category 'testing-outer') ----- testNonResumableOuter self should: [ [Error signal. 4] on: Error do: [:ex | ex outer. ex return: 5] ] raise: Error ! Item was changed: + ----- Method: ExceptionTests>>testNonResumablePass (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testNonResumablePass (in category 'testing-outer') ----- testNonResumablePass self should: [ [Error signal. 4] on: Error do: [:ex | ex pass. ex return: 5] ] raise: Error ! Item was changed: + ----- Method: ExceptionTests>>testOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testOuter (in category 'testing-outer') ----- testOuter | result | result := [[Notification signal. #signal] on: Notification do: [:ex| ex outer. #inner]] on: Notification do: [:ex| #outer]. self assert: result = #outer! Item was changed: + ----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') ----- testResumableFallOffTheEndHandler self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) ! Item was changed: + ----- Method: ExceptionTests>>testResumableOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testResumableOuter (in category 'testing-outer') ----- testResumableOuter | result | result := [Notification signal. 4] on: Notification do: [:ex | ex outer. ex return: 5]. self assert: result = 5 ! Item was changed: + ----- Method: ExceptionTests>>testResumablePass (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testResumablePass (in category 'testing-outer') ----- testResumablePass | result | result := [Notification signal. 4] on: Notification do: [:ex | ex pass. ex return: 5]. self assert: result = 4 ! Item was changed: + ----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'testing-ExceptionTester') ----- testSignalFromHandlerActionTest self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsure (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsure (in category 'testing-ExceptionTester') ----- testSimpleEnsure self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithError self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithNotification self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithUparrow self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleIsNested (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleIsNested (in category 'testing-ExceptionTester') ----- testSimpleIsNested self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleOuter (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleOuter (in category 'testing-ExceptionTester') ----- testSimpleOuter self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimplePass (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimplePass (in category 'testing-ExceptionTester') ----- testSimplePass self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleResignalAs (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleResignalAs (in category 'testing-ExceptionTester') ----- testSimpleResignalAs self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleResume (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleResume (in category 'testing-ExceptionTester') ----- testSimpleResume self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleRetry (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleRetry (in category 'testing-ExceptionTester') ----- testSimpleRetry self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'testing-ExceptionTester') ----- testSimpleRetryUsing self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleReturn (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleReturn (in category 'testing-ExceptionTester') ----- testSimpleReturn self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) ! Item was changed: + ----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'tests') ----- - ----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'testing') ----- testTimeoutWithZeroDuration self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) ! Item was changed: + ----- Method: FileDirectoryTest>>deleteDirectory (in category 'tests - create/delete') ----- - ----- Method: FileDirectoryTest>>deleteDirectory (in category 'create/delete tests') ----- deleteDirectory (self myDirectory exists) ifTrue: [self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName]! Item was changed: + ----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'existence tests') ----- testAttemptExistenceCheckWhenFile "How should a FileDirectory instance respond with an existent file name?" | directory filename | filename := 'aTestFile'. FileDirectory default forceNewFileNamed: filename. directory := FileDirectory default directoryNamed: filename. self shouldnt: [directory exists] description: 'Files are not directories.'. "clean up disk" FileDirectory default deleteFileNamed: filename ifAbsent: [ ]! Item was changed: + ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'tests - create/delete') ----- - ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'create/delete tests') ----- testDeleteDirectory "Test deletion of a directory" | aContainingDirectory preTestItems | aContainingDirectory := self myDirectory containingDirectory. preTestItems := aContainingDirectory fileAndDirectoryNames. self assert: self myAssuredDirectory exists. aContainingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [aContainingDirectory directoryNames includes: self myLocalDirectoryName ] description: 'Should successfully delete directory.'. self should: [preTestItems = aContainingDirectory fileAndDirectoryNames] description: 'Should only delete the indicated directory.'. ! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryExists (in category 'existence tests') ----- testDirectoryExists self assert: self myAssuredDirectory exists. self should: [self myDirectory containingDirectory directoryExists: self myLocalDirectoryName]. self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [self myDirectory containingDirectory directoryExists: self myLocalDirectoryName]! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'existence tests') ----- testDirectoryExistsWhenLikeNamedFileExists [ | testFileName | testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'. (FileStream newFileNamed: testFileName) close. self should: [FileStream isAFileNamed: testFileName]. self shouldnt: [(FileDirectory on: testFileName) exists]] ensure: [self myAssuredDirectory deleteFileNamed: 'zDirExistsTest.testing'] ! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'existence tests') ----- testDirectoryNamed self should: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) pathName = self myDirectory pathName]! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryNicknames (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryNicknames (in category 'existence tests') ----- testDirectoryNicknames | defaultDirectory | defaultDirectory := FileDirectory default. #('/.' '/../../.' '/././.') collect: [ :each | each copyReplaceAll: '/' with: FileDirectory slash ] thenDo: [:each | self assert: (defaultDirectory directoryExists: defaultDirectory fullName, each) description: 'Nickname of "', each, '"'. ]! Item was changed: + ----- Method: FileDirectoryTest>>testExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testExists (in category 'existence tests') ----- testExists self should: [FileDirectory default exists] description: 'Should know default directory exists.'. self should: [self myAssuredDirectory exists] description: 'Should know created directory exists.'. self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) exists] description: 'Should know that recently deleted directory no longer exists.'.! Item was changed: + ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'existence tests') ----- testNonExistentDirectory | directory parentDirectory | directory :=FileDirectory default directoryNamed: 'nonExistentFolder'. self shouldnt: [directory exists] description: 'A FileDirectory instance should know if it points to a non-existent directory.'. parentDirectory :=FileDirectory default. self shouldnt: [parentDirectory directoryExists: 'nonExistentFolder'] description: 'A FileDirectory instance should know when a directory of the given name doesn''t exist'. ! Item was changed: + ----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'existence tests') ----- testOldFileOrNoneNamed | file | file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'. [self assert: file isNil. "Reproduction of Mantis #1049" (self myAssuredDirectory fileNamed: 'test.txt') nextPutAll: 'foo'; close. file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'. self assert: file notNil] ensure: [ file ifNotNil: [file close]. self myAssuredDirectory deleteFileNamed: 'test.txt' ifAbsent: nil] ! Item was changed: + ----- Method: InstallerTest>>testPackageAndVersionNameShouldSanitiseInput (in category 'tests - package and version') ----- - ----- Method: InstallerTest>>testPackageAndVersionNameShouldSanitiseInput (in category 'package and version') ----- testPackageAndVersionNameShouldSanitiseInput | installer | installer := Installer new. self assert: {'Foo'. ''} equals: (installer packageAndVersionFrom: 'Foo'). self assert: {'Foo'. '1'} equals: (installer packageAndVersionFrom: 'Foo(1)'). self assert: {'Foo'. 'head'} equals: (installer packageAndVersionFrom: ' Foo ( head ) ').! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedBranchVersion (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedBranchVersion (in category 'version selection') ----- testSelectFullySpecifiedBranchVersion | installer | installer := InstallerMonticelloMock new. installer setMockCache: listOfFileNames. installer packages: { 'Chronology-Core.UTC-dtl.30' }. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames. installer packages: { 'Chronology-Core.UTC-dtl.30.mcz' }. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedVersion (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedVersion (in category 'version selection') ----- testSelectFullySpecifiedVersion | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core-dtl.30' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-dtl.30.mcz' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-bf.7' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-bf.7.mcz' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous (in category 'version selection') ----- testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous "Documents a bug in earlier versions of the Monticello installer, in which a requiest to load version 3 would load the wrong version if a version 30 existed in the same repository." "(self selector: #testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous) debug" | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core-dtl.3' }. installer setMockCache: listOfFileNames. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-dtl.3.mcz' }. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectLatestVersionForPackage (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectLatestVersionForPackage (in category 'version selection') ----- testSelectLatestVersionForPackage "The listOfFileNames test data set contains more than one Chronology-Core-???.30 version differing by author initials. The first detected in sort order is valid, therefore test only for package, branch, and version number." | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. ! Item was changed: + ----- Method: InstallerTest>>testSelectLatestVersionInBranchForPackage (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectLatestVersionInBranchForPackage (in category 'version selection') ----- testSelectLatestVersionInBranchForPackage "The listOfFileNames test data set contains more than one Chronology-Core.UTC-???.30 version differing by author initials. The first detected in sort order is valid, therefore test only for package, branch, and version number." | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core.UTC' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core.UTC' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. ! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testEmptyReplace (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testEmptyReplace (in category 'testing') ----- testEmptyReplace | array1 array2 | array1 := Array with: 1 with: 2 with: 3 with: 4. array2 := Array with: 5 with: 6 with: 7. self replaceIn: array1 from: 1 to: 0 with: array2 startingAt: 1. self should: [ array1 = #(1 2 3 4) ]. ! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testFlagInCompiledMethod (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testFlagInCompiledMethod (in category 'testing') ----- testFlagInCompiledMethod "this tests that the flag in compiled methods is treated correctly" | method | method := self class compiledMethodAt: #returnTwelve. "turn off the flag" method objectAt: 1 put: (method header bitAnd: (1 << 29) bitInvert). self should: [ method flag not ]. "turn on the flag" method objectAt: 1 put: (method header bitOr: (1 << 29)). self should: [ method flag ]. "try running the method with the flag turned on" self should: [ self returnTwelve = 12 ]. "make sure the flag bit isn't interpreted as a primitive" self should: [ method primitive = 0 ].! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testForgivingPrims (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testForgivingPrims (in category 'testing') ----- testForgivingPrims | aPoint anotherPoint array1 array2 | aPoint := Point x: 5 y: 6. anotherPoint := Point x: 7 y: 8. "make sure there are multiple points floating around" anotherPoint. "stop the compiler complaining about no uses" self assert: Point equals: (self classOf: aPoint). self assert: 5 equals: (self instVarOf: aPoint at: 1). self instVarOf: aPoint at: 2 put: 10. self assert: 10 equals: (self instVarOf: aPoint at: 2). Smalltalk isRunningSpur "Spur does not maintain object ordering..." ifTrue: [self assert: Point equals: (self someInstanceOf: Point) class] ifFalse: [self someObject. self nextObjectAfter: aPoint. self assert: Point equals: (self someInstanceOf: Point) class. self assert: Point equals: (self nextInstanceAfter: aPoint) class]. array1 := Array with: 1 with: 2 with: 3. array2 := Array with: 4 with: 5 with: 6. self replaceIn: array1 from: 2 to: 3 with: array2 startingAt: 1. self assert: #(1 4 5) equals: array1.! Item was changed: + ----- Method: LocaleTest>>expectedFailures (in category 'failures') ----- - ----- Method: LocaleTest>>expectedFailures (in category 'testing') ----- expectedFailures ^ super expectedFailures, ((NaturalLanguageTranslator translators isEmpty or: [(NaturalLanguageTranslator translators values collect: [:t | t localeID ]) asSet size = 1]) ifTrue: [#(testLocaleChanged) "no locale available to switch to"] ifFalse: [ #()]), #(testIsFontAvailable "metatoys.org is not accessible") ! Item was changed: + ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'testing') ----- testCannotLoad | d | d := self mockClass: 'MCMockClassC' super: 'NotAnObject'. self should: [d load] raise: Error. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: + ----- Method: MCClassDefinitionTest>>testComparison (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testComparison (in category 'testing') ----- testComparison | d1 d2 d3 d4 | d1 := self mockClass: 'A' super: 'X'. d2 := self mockClass: 'A' super: 'Y'. d3 := self mockClass: 'B' super: 'X'. d4 := self mockClass: 'B' super: 'X'. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self assert: (d3 isRevisionOf: d4). self assert: (d3 isSameRevisionAs: d4). self deny: (d1 isRevisionOf: d3). self deny: (d4 isRevisionOf: d2).! Item was changed: + ----- Method: MCClassDefinitionTest>>testCreation (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testCreation (in category 'testing') ----- testCreation | d | d := self mockClassA asClassDefinition. self assert: d className = #MCMockClassA. self assert: d superclassName = #MCMock. self assert: d type = #normal. self assert: d category = self mockCategoryName. self assert: d instVarNames asArray = #('ivar'). self assert: d classVarNames asArray = #('CVar'). self assert: d classInstVarNames asArray = #(). self assert: d comment isString. self assert: d comment = self classAComment. self assert: d commentStamp = self mockClassA organization commentStamp! Item was changed: + ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'testing') ----- testDefinitionString | d | d := self mockClassA asClassDefinition. self assert: d definitionString = self mockClassA definition.! Item was changed: + ----- Method: MCClassDefinitionTest>>testEquals (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testEquals (in category 'testing') ----- testEquals | a b | a := self mockClass: 'ClassA' super: 'SuperA'. b := self mockClass: 'ClassA' super: 'SuperA'. self assert: a = b! Item was changed: + ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'testing') ----- testEqualsSensitivity | message a b defA args defB | message := self creationMessage. a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA) typeA 'A comment' 'A'). b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB) typeB 'B comment' 'B'). defA := message valueWithArguments: a. 1 to: 8 do: [:index | args := a copy. args at: index put: (b at: index). defB := message valueWithArguments: args. self deny: defA = defB.]! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'testing - class type') ----- testKindOfSubclass {self mockClassA. String. ByteString. WideString. BlockClosure. WeakArray. BoxedFloat64. SmallFloat64. CompiledMethod. ByteArray. DoubleByteArray. IntegerArray. DoubleWordArray. } do: [:c | self assert: c asClassDefinition kindOfSubclass equals: c kindOfSubclass]! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledBlock (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledBlock (in category 'testing - class type') ----- testKindOfSubclassForCompiledBlock "CompiledCode and its subclasses are a special case." | classDef | "CompiledBlock should be like CompiledMethod, both now are subclassed from CompiledCode" classDef := self mockClass: #CompiledBlock super: #CompiledCode. self assert: #compiledMethod equals: classDef type. self assert: CompiledBlock typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledCode (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledCode (in category 'testing - class type') ----- testKindOfSubclassForCompiledCode "CompiledCode and its subclasses are a special case." | classDef | "CompiledMethod is now a subclass of CompiledCode, which is also of type #compiledMethod" classDef := self mockClass: #CompiledCode super: #ByteArray. self assert: #compiledMethod equals: classDef type. self assert: CompiledCode typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledMethod (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledMethod (in category 'testing - class type') ----- testKindOfSubclassForCompiledMethod "CompiledCode and its subclasses are a special case." | classDef | classDef := self mockClass: #CompiledMethod super: #CompiledCode. self assert: #compiledMethod equals: classDef type. self assert: CompiledMethod typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForSocketAddress (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForSocketAddress (in category 'testing - class type') ----- testKindOfSubclassForSocketAddress "A subclass of ByteArray that is not treated specially" | classDef | classDef := self mockClass: #SocketAddress super: #ByteArray. self assert: #bytes equals: classDef type. self assert: SocketAddress typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'testing') ----- testLoadAndUnload | d c | d := self mockClass: 'MCMockClassC' super: 'Object'. d load. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). c := (Smalltalk classNamed: 'MCMockClassC'). self assert: (c isKindOf: Class). self assert: c superclass = Object. self assert: c instVarNames isEmpty. self assert: c classVarNames isEmpty. self assert: c sharedPools isEmpty. self assert: c category = self mockCategoryName. self assert: c organization classComment = (self commentForClass: 'MCMockClassC'). self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC'). d unload. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: + ----- Method: MCEnvironmentLoadTest>>testLoadIntoEnvironment (in category 'tests') ----- - ----- Method: MCEnvironmentLoadTest>>testLoadIntoEnvironment (in category 'testing') ----- testLoadIntoEnvironment [[MCPackageLoader installSnapshot: self mockSnapshot] valueSupplyingAnswers: #(('The pool dictionary*does not exist*automatically created?' true))] on: CurrentEnvironment do: [:e | e resume: environment]. self assert: (environment bindingOf: #MCMockClassA) notNil description: 'Environment has no binding for MCMockClassA'.! Item was changed: + ----- Method: MCFileInTest>>alterInitialState (in category 'private') ----- - ----- Method: MCFileInTest>>alterInitialState (in category 'testing') ----- alterInitialState self mockClassA touchCVar! Item was changed: + ----- Method: MCFileInTest>>assertFileOutFrom:canBeFiledInWith: (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertFileOutFrom:canBeFiledInWith: (in category 'testing') ----- assertFileOutFrom: writerClass canBeFiledInWith: aBlock (writerClass on: stream) writeSnapshot: self mockSnapshot. self alterInitialState. self assertSuccessfulLoadWith: aBlock. self mockPackage unload. self assertSuccessfulLoadWith: aBlock. ! Item was changed: + ----- Method: MCFileInTest>>assertInitializersCalled (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertInitializersCalled (in category 'testing') ----- assertInitializersCalled | cvar | cvar := self mockClassA cVar. self assert: cvar = #initialized! Item was changed: + ----- Method: MCFileInTest>>assertSuccessfulLoadWith: (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertSuccessfulLoadWith: (in category 'testing') ----- assertSuccessfulLoadWith: aBlock stream reset. aBlock value. self assertNoChange. self assertInitializersCalled.! Item was changed: + ----- Method: MCFileInTest>>testStWriter (in category 'tests') ----- - ----- Method: MCFileInTest>>testStWriter (in category 'testing') ----- testStWriter <timeout: 30> "takes a little longer" self assertFileOutFrom: MCStWriter canBeFiledInWith: [stream fileIn]. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testDefault (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testDefault (in category 'testing') ----- testDefault | defaultMapFromPreference defaultURLFromPreference defaultUpdater | defaultMapFromPreference := MCMcmUpdater updateMapName. defaultURLFromPreference := MCMcmUpdater defaultUpdateURL. defaultUpdater := MCMcmUpdater default. "create and register" self assert: defaultMapFromPreference equals: defaultUpdater updateMapName. self assert: defaultURLFromPreference equals: defaultUpdater repository. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1 ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testRegistryIsBeingSaved (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testRegistryIsBeingSaved (in category 'testing') ----- testRegistryIsBeingSaved "setUp and tearDown save and restore the current state" self assert: MCMcmUpdater registry isNil! Item was changed: + ----- Method: MCMcmUpdaterTest>>testTwoUpdatersForOneRepository (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testTwoUpdatersForOneRepository (in category 'testing') ----- testTwoUpdatersForOneRepository | reg updater1 updater2 | reg := MCMcmUpdater registry. updater1 := MCMcmUpdater updateMapNamed: 'BAR' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 := MCMcmUpdater updateMapNamed: 'BAZ' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 2. updater1 unregister. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 unregister. self assert: MCMcmUpdater registry isEmpty. self should: [MCMcmUpdater registry at: 'FOO'] raise: Error. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testTwoUpdatersInDifferentRepositories (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testTwoUpdatersInDifferentRepositories (in category 'testing') ----- testTwoUpdatersInDifferentRepositories | reg updater1 updater2 | reg := MCMcmUpdater registry. updater1 := MCMcmUpdater updateMapNamed: 'BAR' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 := MCMcmUpdater updateMapNamed: 'BAZ' repository: 'FOO2'. self assert: MCMcmUpdater registry size = 2. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. self assert: (MCMcmUpdater registry at: 'FOO2') size = 1. updater1 unregister. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO2') size = 1. updater2 unregister. self assert: MCMcmUpdater registry isEmpty. self should: [MCMcmUpdater registry at: 'FOO'] raise: Error. self should: [MCMcmUpdater registry at: 'FOO2'] raise: Error. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testUpdatePreferences (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testUpdatePreferences (in category 'testing') ----- testUpdatePreferences | defaultMapFromPreference defaultURLFromPreference defaultUpdater | defaultMapFromPreference := MCMcmUpdater updateMapName. defaultURLFromPreference := MCMcmUpdater defaultUpdateURL. defaultUpdater := MCMcmUpdater default. "create and register" self assert: defaultMapFromPreference equals: defaultUpdater updateMapName. self assert: defaultURLFromPreference equals: defaultUpdater repository. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1. [ | newDefault | MCMcmUpdater updateMapName: 'NEWMAP'. "new instance not yet registered" self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1. self shouldnt: [MCMcmUpdater registry at: defaultURLFromPreference] raise: Error. self should: [(MCMcmUpdater registry at: defaultURLFromPreference) at: 'NEWMAP'] raise: Error. newDefault := MCMcmUpdater default. "create and register new default updater" self shouldnt: [(MCMcmUpdater registry at: defaultURLFromPreference) at: 'NEWMAP'] raise: Error. self assert: 'NEWMAP' equals: newDefault updateMapName. MCMcmUpdater defaultUpdateURL: 'NEWURL'. self assert: MCMcmUpdater registry size = 1. newDefault := MCMcmUpdater default. "create and register new default updater" self assert: MCMcmUpdater registry size = 2. self shouldnt: [(MCMcmUpdater registry at: 'NEWURL') at: 'NEWMAP'] raise: Error. self assert: 'NEWURL' equals: newDefault repository. self assert: 'NEWMAP' equals: newDefault updateMapName. ] ensure: [ "restore preferences" MCMcmUpdater updateMapName: defaultMapFromPreference. MCMcmUpdater defaultUpdateURL: defaultURLFromPreference ] ! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'tests') ----- - ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'testing') ----- testInstallFromFile MCMczWriter fileOut: expected on: self fileStream. MczInstaller installFileNamed: self fileName. self assertNoChange.! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'tests') ----- - ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'testing') ----- testInstallFromStream | stream | stream := RWBinaryOrTextStream on: String new. MCMczWriter fileOut: expected on: stream. MczInstaller installStream: stream reset. self assertNoChange. self assertVersionInfoPresent. ! Item was changed: + ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'testing') ----- testCannotLoad | definition | definition := self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false. self should: [definition load] raise: Error. self assert: (navigation allImplementorsOf: #kjahs87) isEmpty! Item was changed: + ----- Method: MCMethodDefinitionTest>>testComparison (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testComparison (in category 'testing') ----- testComparison |d1 d2 d3 d4 d5 | d1 := self mockMethod: #one class: 'A' source: '1' meta: false. d2 := self mockMethod: #one class: 'A' source: '2' meta: false. d3 := self mockMethod: #one class: 'A' source: '1' meta: true. d4 := self mockMethod: #two class: 'A' source: '1' meta: false. d5 := self mockMethod: #two class: 'A' source: '1' meta: false. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self deny: (d1 isRevisionOf: d3). self deny: (d1 isRevisionOf: d4). self assert: (d4 isSameRevisionAs: d5).! Item was changed: + ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'testing') ----- testLoadAndUnload |definition| definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false. self assert: self mockInstanceA one = 1. definition load. self assert: self mockInstanceA one = 2. definition unload. self deny: (self mockInstanceA respondsTo: #one)! Item was changed: + ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'testing') ----- testPartiallyRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz'. self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory. self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory. definition := (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod. self assert: self override = 4. definition unload. self assert: self override = 2. self assert: (MethodReference class: self class selector: #override) category = '*foobarbaz'. ! Item was changed: + ----- Method: MCMethodDefinitionTest>>testRevertOldMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testRevertOldMethod (in category 'testing') ----- testRevertOldMethod | definition changeRecord | Object compile: 'yourself ^ self' classified: self mockOverrideMethodCategory. definition := (MethodReference class: Object selector: #yourself) asMethodDefinition. changeRecord := definition scanForPreviousVersions first. self assert: changeRecord notNil. self assert: changeRecord category = 'accessing'. changeRecord fileIn.! Item was changed: + ----- Method: MCMethodDefinitionTest>>testRevertOverrideMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testRevertOverrideMethod (in category 'testing') ----- testRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz-override'. definition := (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod description: 'Method not marked as an override'. self assert: 2 equals: self override description: 'Method not overridden'. definition unload. self assert: 1 equals: self override description: 'Unload didn''t revert method'. self assert: 'mocks' equals: (MethodReference class: self class selector: #override) category description: 'Unload didn''t revert. method classification'. ! Item was changed: + ----- Method: MCOrganizationTest>>testReordering (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReordering (in category 'testing') ----- testReordering |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(B C A). self assert: newCats asArray = #(X Y A B C Z Q).! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'testing') ----- testReorderingWithNoCategoriesInVersion |dec cats newCats | dec := MCOrganizationDefinition categories: #(). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(). self assert: newCats asArray = cats.! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'testing') ----- testReorderingWithRemovals |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(Y B C A Q). self assert: newCats asArray = #(X A B C Z).! Item was changed: + ----- Method: MCPatchTest>>testPatchContents (in category 'tests') ----- - ----- Method: MCPatchTest>>testPatchContents (in category 'testing') ----- testPatchContents self assert: patch operations size = 1. self assert: patch operations first isModification. self assert: patch operations first definition selector = #one. ! Item was changed: + ----- Method: MCSerializationTest>>testMcdSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testMcdSerialization (in category 'testing') ----- testMcdSerialization | stream expected actual | <timeout: 30> expected := self mockDiffyVersion. stream := RWBinaryOrTextStream on: String new. MCMcdWriter fileOut: expected on: stream. actual := MCMcdReader versionFromStream: stream reset. self assertVersion: actual matches: expected.! Item was changed: + ----- Method: MCSerializationTest>>testMczSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testMczSerialization (in category 'testing') ----- testMczSerialization <timeout: 30> self assertVersionsMatchWith: MCMczWriter. self assertExtensionProvidedBy: MCMczWriter. self assertVersionInfosMatchWith: MCMczWriter. self assertDependenciesMatchWith: MCMczWriter.! Item was changed: + ----- Method: MCSerializationTest>>testStSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testStSerialization (in category 'testing') ----- testStSerialization self assertSnapshotsMatchWith: MCStWriter.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testAnnotationPane (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testAnnotationPane (in category 'testing') ----- testAnnotationPane | oldPref | oldPref := Preferences annotationPanes. Preferences disable: #annotationPanes. self buildWindow. self assert: (self morphsOfClass: TextMorph) size = 1. Preferences enable: #annotationPanes. self buildWindow. self assert: (self morphsOfClass: TextMorph) size = 2. Preferences setPreference: #annotationPanes toValue: oldPref! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testCategorySelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testCategorySelected (in category 'testing') ----- testCategorySelected self clickOnListItem: self mockCategoryName. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: ''.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testClassSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testClassSelected (in category 'testing') ----- testClassSelected self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testClassSideClassSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testClassSideClassSelected (in category 'testing') ----- testClassSideClassSelected self clickOnButton: 'class'. self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAClassProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testComment (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testComment (in category 'testing') ----- testComment self clickOnButton: '?'. self assertTextIs: ''. self clickOnListItem: self mockCategoryName. self assertTextIs: ''. self clickOnListItem: 'MCMockClassA'. self assertTextIs: self classAComment.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testFourColumns (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testFourColumns (in category 'testing') ----- testFourColumns self assert: self listMorphs size = 4.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testMethodIsCleared (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testMethodIsCleared (in category 'testing') ----- testMethodIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self clickOnListItem: '-- all --'. self denyAListHasSelection: 'falsehood'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testMethodSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testMethodSelected (in category 'testing') ----- testMethodSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: self falsehoodMethodSource.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'testing') ----- testNoSelection self assertAListMatches: self allCategories. self denyAListIncludesAnyOf: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. "and if there I need to see the packages scripts (or none)" self assertTextIs: '(package defines no scripts)'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testProtocolIsCleared (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testProtocolIsCleared (in category 'testing') ----- testProtocolIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockASubclass'. self clickOnListItem: 'as yet unclassified'. self clickOnListItem: 'MCMockClassA'. self denyAListHasSelection: 'as yet unclassified'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testProtocolSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testProtocolSelected (in category 'testing') ----- testProtocolSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: ''. ! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'testing') ----- testTextPane "This shouldn't raise an exception." self textMorph.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testThreeButtons (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testThreeButtons (in category 'testing') ----- testThreeButtons self assertButtonExists: 'instance'. self assertButtonExists: '?'. self assertButtonExists: 'class'.! Item was changed: + ----- Method: MCStWriterTest>>expectedInitializerA (in category 'data') ----- - ----- Method: MCStWriterTest>>expectedInitializerA (in category 'testing') ----- expectedInitializerA ^ 'MCMockClassA initialize'! Item was changed: ----- Method: MCStWriterTest>>expectedMethodDefinitionWithBangs (in category 'data') ----- expectedMethodDefinitionWithBangs ^' + !!MCStWriterTest methodsFor: ''data'' stamp: ''ar 1/4/2010 18:03''!! - !!MCStWriterTest methodsFor: ''testing'' stamp: ''ar 1/4/2010 18:03''!! methodWithBangs ^ '' ^ ReadStream on: ''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!! MCOrganizationDeclaration categories: #( ''''Tests-Monticello-Mocks'''')!!!!!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''''Tests-Monticello-Mocks'''' instVarNames: #() comment: ''''''''!!!!!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''''as yet unclassified'''' timeStamp: ''''cwp 7/8/2003 21:21'''' source: ''''one ^ 1''''!!!!!!!! '''' '' !! !! '! Item was changed: + ----- Method: MCStWriterTest>>methodWithBangs (in category 'data') ----- - ----- Method: MCStWriterTest>>methodWithBangs (in category 'testing') ----- methodWithBangs ^ ' ^ ReadStream on: ''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!! MCOrganizationDeclaration categories: #( ''Tests-Monticello-Mocks'')!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''Tests-Monticello-Mocks'' instVarNames: #() comment: ''''!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''as yet unclassified'' timeStamp: ''cwp 7/8/2003 21:21'' source: ''one ^ 1''!!!! '' ' ! Item was changed: + ----- Method: MCStWriterTest>>setUp (in category 'running') ----- - ----- Method: MCStWriterTest>>setUp (in category 'testing') ----- setUp stream := RWBinaryOrTextStream on: String new. writer := MCStWriter on: stream. ! Item was changed: + ----- Method: MCStWriterTest>>tearDown (in category 'running') ----- - ----- Method: MCStWriterTest>>tearDown (in category 'testing') ----- tearDown SystemOrganizer default removeEmptyCategories. super tearDown ! Item was changed: + ----- Method: MCStWriterTest>>testClassDefinitionA (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassDefinitionA (in category 'testing') ----- testClassDefinitionA writer visitClassDefinition: (self mockClassA asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionA. stream reset. 2 timesRepeat: [self assertChunkIsWellFormed: stream nextChunk]! Item was changed: + ----- Method: MCStWriterTest>>testClassDefinitionB (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassDefinitionB (in category 'testing') ----- testClassDefinitionB writer visitClassDefinition: (self mockClassB asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionB. ! Item was changed: + ----- Method: MCStWriterTest>>testClassMethodDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassMethodDefinition (in category 'testing') ----- testClassMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA class selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedClassMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'testing') ----- testInitializerDefinition |chunk lastChunk| writer writeSnapshot: self mockSnapshot. stream reset. [stream atEnd] whileFalse: [chunk := stream nextChunk. chunk isAllSeparators ifFalse: [lastChunk := chunk]]. self assertContentsOf: lastChunk readStream match: self expectedInitializerA! Item was changed: + ----- Method: MCStWriterTest>>testMethodDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testMethodDefinition (in category 'testing') ----- testMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testMethodDefinitionWithBangs (in category 'tests') ----- - ----- Method: MCStWriterTest>>testMethodDefinitionWithBangs (in category 'testing') ----- testMethodDefinitionWithBangs writer visitMethodDefinition: (MethodReference class: self class selector: #methodWithBangs) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinitionWithBangs. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'testing') ----- testOrganizationDefinition | definition | definition := MCOrganizationDefinition categories: (self mockPackage packageInfo systemCategories). writer visitOrganizationDefinition: definition. self assertContentsOf: stream match: self expectedOrganizationDefinition. self assertAllChunksAreWellFormed.! Item was changed: + ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'failures') ----- - ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'testing') ----- expectedFailures "All versions of Cog provide mirror primitive support. For the interpreter VM, support was added in version 4.7.19. Identify expected failures for older versions of the interpreter VM." ^Smalltalk isRunningCog ifTrue: [#()] ifFalse: [ | ver | [ver := VersionNumber fromString: Smalltalk vm interpreterSourceVersion. ((ver numbers first * 1000) + ver numbers second) >= 4008 ifTrue: [^#() "version 4.7.19 or greater with mirror primitive support"]] on: Warning do: ["primitiveInterpreterSourceVersion not available"]. ^#(testMirrorEqEq testMirrorPerform testMirrorSize) "older interpreter VMs"] ! Item was changed: + ----- Method: PCCByLiteralsTest>>setUp (in category 'running') ----- - ----- Method: PCCByLiteralsTest>>setUp (in category 'tests') ----- setUp super setUp. "disable external calls" (self class selectors select: [:sel | sel beginsWith: 'lDisabled']) do: [:sel | (self class >> sel) literals first at: 4 put: -2]! Item was changed: + ----- Method: SmalltalkImageTest>>testImageName (in category 'tests') ----- - ----- Method: SmalltalkImageTest>>testImageName (in category 'testing') ----- testImageName "Non regression test for http://bugs.squeak.org/view.php?id=7351" | shortImgName fullImgName fullChgName | shortImgName := 'Squeak3.10.2-7179-basic'. fullImgName := Smalltalk fullNameForImageNamed: shortImgName. fullChgName := Smalltalk fullNameForChangesNamed: shortImgName. FileDirectory splitName: fullImgName to: [:path :name | self assert: path = Smalltalk imagePath. self assert: name = 'Squeak3.10.2-7179-basic.image'.]. FileDirectory splitName: fullChgName to: [:path :name | self assert: path = Smalltalk imagePath. self assert: name = 'Squeak3.10.2-7179-basic.changes'.].! Item was changed: + ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsClassForClasses (in category 'tests - classes and traits') ----- - ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsClassForClasses (in category 'testing - classes and traits') ----- testClassOrTraitNamedReturnsClassForClasses self assert: Object == (Smalltalk globals classOrTraitNamed: 'Object'). self assert: Object == (Smalltalk globals classOrTraitNamed: #Object).! Item was changed: + ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsNilForGlobals (in category 'tests - classes and traits') ----- - ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsNilForGlobals (in category 'testing - classes and traits') ----- testClassOrTraitNamedReturnsNilForGlobals self assert: nil = (Smalltalk globals classOrTraitNamed: 'Undeclared'). self assert: nil = (Smalltalk globals classOrTraitNamed: #Undeclared).!

1 0

The Trunk: CommandLine-pre.13.mcz
by commits＠source.squeak.org 30 Apr '19

30 Apr '19

Patrick Rein uploaded a new version of CommandLine to project The Trunk: http://source.squeak.org/trunk/CommandLine-pre.13.mcz ==================== Summary ==================== Name: CommandLine-pre.13 Author: pre Time: 30 April 2019, 3:28:42.737906 pm UUID: f19eb98b-5b82-b84e-b754-8ce35bafa52f Ancestors: CommandLine-tpr.12 Makes the ProvideAnswerNotification handling more robust with regard to the input (actual value or index) =============== Diff against CommandLine-tpr.12 =============== Item was changed: ----- Method: DummyUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- chooseFrom: labelList values: valueList lines: linesArray title: aString self askForProvidedAnswerTo: aString ifSupplied: [:answer | (answer = #cancel or: [answer isNil]) ifTrue: [^ nil]. + ^ valueList at: (valueList indexOf: answer) ifAbsent: [ + answer isNumber + ifTrue: [valueList at: answer ifAbsent: [nil]] + ifFalse: [nil]]]. - ^ valueList at: (valueList indexOf: answer)]. ^ valueList first!

1 0