[Pkg] The Inbox: CollectionsTests-ul.103.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 13 00:46:28 UTC 2009
A new version of CollectionsTests was added to project The Inbox:
http://source.squeak.org/inbox/CollectionsTests-ul.103.mcz
==================== Summary ====================
Name: CollectionsTests-ul.103
Author: ul
Time: 13 October 2009, 1:24:34 am
UUID: 147381f0-d6ad-1944-9161-e80548af6cf1
Ancestors: CollectionsTests-nice.102
tests for String >> #format: and String >> #withBlanksTrimmed
==================== Snapshot ====================
SystemOrganization addCategory: #'CollectionsTests-Abstract'!
SystemOrganization addCategory: #'CollectionsTests-Arrayed'!
SystemOrganization addCategory: #'CollectionsTests-Sequenceable'!
SystemOrganization addCategory: #'CollectionsTests-Stack'!
SystemOrganization addCategory: #'CollectionsTests-Streams'!
SystemOrganization addCategory: #'CollectionsTests-Support'!
SystemOrganization addCategory: #'CollectionsTests-Text'!
SystemOrganization addCategory: #'CollectionsTests-Unordered'!
SystemOrganization addCategory: #'CollectionsTests-Weak'!
TestCase subclass: #BagTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
----- 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
!
----- 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).
!
----- Method: BagTest>>testAsBag (in category 'basic tests') -----
testAsBag
| aBag |
aBag := Bag new.
self assert: aBag asBag = aBag.!
----- 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
!
----- 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.!
----- Method: BagTest>>testCreation (in category 'tests') -----
testCreation
"self run: #testCreation"
"self debug: #testCreation"
| bag |
bag := Bag new.
self assert: (bag size) = 0.
self assert: (bag isEmpty).
!
----- Method: BagTest>>testCumulativeCounts (in category 'tests') -----
testCumulativeCounts
"self run: #testCumulativeCounts"
"self debug: #testCumulativeCounts"
| bag cumulativeCounts |
bag := Bag new.
bag add: '1' withOccurrences: 50.
bag add: '2' withOccurrences: 40.
bag add: '3' withOccurrences: 10.
cumulativeCounts := bag cumulativeCounts.
self assert: cumulativeCounts size = 3.
self assert: cumulativeCounts first = (50 -> '1').
self assert: cumulativeCounts second = (90 -> '2').
self assert: cumulativeCounts third = (100 -> '3').
!
----- Method: BagTest>>testEqual (in category 'tests') -----
testEqual
"(self run: #testEqual)"
"(self debug: #testEqual)"
| bag1 bag2 |
bag1 := Bag new.
bag2 := Bag new.
self assert: bag1 = bag2.
bag1 add: #a;
add: #b.
bag2 add: #a;
add: #a.
self deny: bag1 = bag2.
self assert: bag1 = bag1.
bag1 add: #a.
bag2 add: #b.
self assert: bag1 = bag2.
bag1 add: #c.
self deny: bag1 = bag2.
bag2 add: #c.
self assert: bag1 = bag2!
----- 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.
!
----- Method: BagTest>>testRemove (in category 'tests') -----
testRemove
"self run: #testRemove"
"self debug: #testRemove"
| bag item |
item := 'test item'.
bag := Bag new.
bag add: item.
self assert: (bag size) = 1.
bag remove: item.
self assert: bag isEmpty.
bag add: item withOccurrences: 2.
bag remove: item.
bag remove: item.
self assert: (bag size) = 0.
self should: [bag remove: item.] raise: Error.!
----- Method: BagTest>>testRemoveAll (in category 'tests') -----
testRemoveAll
"Allows one to remove all elements of a collection"
| c1 c2 s2 |
c1 := #(10 9 8 7 5 4 4 2) asBag.
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'.!
----- Method: BagTest>>testSortedCounts (in category 'tests') -----
testSortedCounts
"self run: #testSortedCounts"
"self debug: #testSortedCounts"
| bag sortedCounts|
bag := Bag new.
bag add: '1' withOccurrences: 10.
bag add: '2' withOccurrences: 1.
bag add: '3' withOccurrences: 5.
sortedCounts := bag sortedCounts.
self assert: sortedCounts size = 3.
self assert: sortedCounts first = (10->'1').
self assert: sortedCounts second = (5->'3').
self assert: sortedCounts third = (1->'2'). !
----- Method: BagTest>>testSortedElements (in category 'tests') -----
testSortedElements
"self run: #testSortedElements"
"self debug: #testSortedElements"
| bag sortedElements|
bag := Bag new.
bag add: '2' withOccurrences: 1.
bag add: '1' withOccurrences: 10.
bag add: '3' withOccurrences: 5.
sortedElements := bag sortedElements.
self assert: sortedElements size = 3.
self assert: sortedElements first = ('1'->10).
self assert: sortedElements second = ('2'->1).
self assert: sortedElements third = ('3'->5).
!
TestCase subclass: #Base64MimeConverterTest
instanceVariableNames: 'message'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Streams'!
!Base64MimeConverterTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Base64MimeConverter. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: Base64MimeConverterTest>>setUp (in category 'initialize-release') -----
setUp
message := 'Hi There!!' readStream.
!
----- Method: Base64MimeConverterTest>>testBase64Encoded (in category 'tests') -----
testBase64Encoded
| encoded |
encoded := (Base64MimeConverter mimeEncode: message) contents.
self assert: encoded = 'Hi There!!' base64Encoded.
!
----- Method: Base64MimeConverterTest>>testMimeEncodeDecode (in category 'tests') -----
testMimeEncodeDecode
| encoded |
encoded := Base64MimeConverter mimeEncode: message.
self assert: (encoded contents = 'SGkgVGhlcmUh').
self assert: ((Base64MimeConverter mimeDecodeToChars: encoded) contents = message contents).
"Encoding should proceed from the current stream position."
message reset.
message skip: 2.
encoded := Base64MimeConverter mimeEncode: message.
self assert: (encoded contents = 'IFRoZXJlIQ==').!
----- Method: Base64MimeConverterTest>>testOnByteArray (in category 'tests') -----
testOnByteArray
self assert: ('Hi There!!' base64Encoded = 'Hi There!!' asByteArray base64Encoded)!
TestCase subclass: #CharacterSetTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Support'!
!CharacterSetTest commentStamp: 'nice 11/20/2007 00:35' prior: 0!
CharacterSetTest holds tests for CharacterSet!
----- Method: CharacterSetTest>>testCopy (in category 'testing') -----
testCopy
| theOriginal theCopy |
theOriginal := CharacterSet newFrom: 'abc'.
theCopy := theOriginal copy.
theCopy remove: $a.
^self should: [theOriginal includes: $a] description: 'Changing the copy should not change the original'.!
TestCase subclass: #CollectionTest
instanceVariableNames: 'empty nonEmpty'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Abstract'!
!CollectionTest commentStamp: '<historical>' prior: 0!
A TestCase is a Command representing the future running of a test case. Create one with the class method #selector: aSymbol, passing the name of the method to be run when the test case runs.
When you discover a new fixture, subclass TestCase, declare instance variables for the objects in the fixture, override #setUp to initialize the variables, and possibly override# tearDown to deallocate any external resources allocated in #setUp.
When you are writing a test case method, send #assert: aBoolean when you want to check for an expected value. For example, you might say "self assert: socket isOpen" to test whether or not a socket is open at a point in a test.!
----- Method: CollectionTest>>setUp (in category 'initialize-release') -----
setUp
empty := Set new.
nonEmpty := OrderedCollection with: #x!
----- Method: CollectionTest>>testAsCommaString (in category 'testing') -----
testAsCommaString
{OrderedCollection new. Set new.} do:
[ :coll |
self assert: coll asCommaString = ''.
coll add: 1.
self assert: coll asCommaString = '1'.
coll add: 2; add: 3.
self assert: coll asCommaString = '1, 2, 3'].!
----- Method: CollectionTest>>testAsCommaStringAnd (in category 'testing') -----
testAsCommaStringAnd
{OrderedCollection new. Set new.} do:
[ :coll |
self assert: coll asCommaStringAnd = ''.
coll add: 1.
self assert: coll asCommaStringAnd = '1'.
coll add: 2; add: 3.
self assert: coll asCommaStringAnd = '1, 2 and 3'].!
----- Method: CollectionTest>>testAsStringOnDelimiter (in category 'testing') -----
testAsStringOnDelimiter
| delim emptyStream oneItemStream multiItemStream |
delim := ', '.
{OrderedCollection new. Set new.} do:
[ :coll |
emptyStream := ReadWriteStream on: ''.
coll asStringOn: emptyStream delimiter: delim.
self assert: emptyStream contents = ''.
coll add: 1.
oneItemStream := ReadWriteStream on: ''.
coll asStringOn: oneItemStream delimiter: delim.
self assert: oneItemStream contents = '1'.
coll add: 2; add: 3.
multiItemStream := ReadWriteStream on: ''.
coll asStringOn: multiItemStream delimiter: ', '.
self assert: multiItemStream contents = '1, 2, 3'.]!
----- Method: CollectionTest>>testAsStringOnDelimiterLast (in category 'testing') -----
testAsStringOnDelimiterLast
| delim emptyStream last oneItemStream multiItemStream |
delim := ', '.
last := ' & '.
{OrderedCollection new. Set new.} do:
[ :coll |
emptyStream := ReadWriteStream on: ''.
coll asStringOn: emptyStream delimiter: delim last: last.
self assert: emptyStream contents = ''.
coll add: 1.
oneItemStream := ReadWriteStream on: ''.
coll asStringOn: oneItemStream delimiter: delim last: last.
self assert: oneItemStream contents = '1'.
coll add: 2; add: 3.
multiItemStream := ReadWriteStream on: ''.
coll asStringOn: multiItemStream delimiter: ', ' last: last.
self assert: multiItemStream contents = '1, 2 & 3'.]!
----- Method: CollectionTest>>testIfEmptyifNotEmpty (in category 'tests') -----
testIfEmptyifNotEmpty
self assert: (empty ifEmpty: [true] ifNotEmpty: [false]).
self assert: (nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
self assert: (nonEmpty ifEmpty: [false] ifNotEmpty: [:s | s first = #x])!
----- Method: CollectionTest>>testIfEmptyifNotEmptyDo (in category 'tests') -----
testIfEmptyifNotEmptyDo
self assert: (empty ifEmpty: [true] ifNotEmptyDo: [:s | false]).
self assert: (nonEmpty ifEmpty: [false] ifNotEmptyDo: [:s | s first = #x])!
----- Method: CollectionTest>>testIfNotEmpty (in category 'tests') -----
testIfNotEmpty
empty ifNotEmpty: [self assert: false].
self assert: (nonEmpty ifNotEmpty: [self]) == self.
self assert: (nonEmpty ifNotEmpty: [:s | s first]) = #x
!
----- Method: CollectionTest>>testIfNotEmptyDo (in category 'tests') -----
testIfNotEmptyDo
empty ifNotEmptyDo: [:s | self assert: false].
self assert: (nonEmpty ifNotEmptyDo: [:s | s first]) = #x
!
----- Method: CollectionTest>>testIfNotEmptyDoifNotEmpty (in category 'tests') -----
testIfNotEmptyDoifNotEmpty
self assert: (empty ifNotEmptyDo: [:s | false] ifEmpty: [true]).
self assert: (nonEmpty ifNotEmptyDo: [:s | s first = #x] ifEmpty: [false])!
----- Method: CollectionTest>>testIfNotEmptyifEmpty (in category 'tests') -----
testIfNotEmptyifEmpty
self assert: (empty ifEmpty: [true] ifNotEmpty: [false]).
self assert: (nonEmpty ifEmpty: [false] ifNotEmpty: [true]).
self assert: (nonEmpty ifEmpty: [false] ifNotEmpty: [:s | s first = #x])!
----- Method: CollectionTest>>testPrintOnDelimiter (in category 'testing') -----
testPrintOnDelimiter
| delim emptyStream oneItemStream multiItemStream |
delim := ', '.
{OrderedCollection new. Set new.} do:
[ :coll |
emptyStream := ReadWriteStream on: ''.
coll printOn: emptyStream delimiter: delim.
self assert: emptyStream contents = ''.
coll add: 1.
oneItemStream := ReadWriteStream on: ''.
coll printOn: oneItemStream delimiter: delim.
self assert: oneItemStream contents = '1'.
coll add: 2; add: 3.
multiItemStream := ReadWriteStream on: ''.
coll printOn: multiItemStream delimiter: ', '.
self assert: multiItemStream contents = '1'', ''2'', ''3'.]!
----- Method: CollectionTest>>testPrintOnDelimiterLast (in category 'testing') -----
testPrintOnDelimiterLast
| delim emptyStream last oneItemStream multiItemStream |
delim := ', '.
last := ' & '.
{OrderedCollection new. Set new.} do:
[ :coll |
emptyStream := ReadWriteStream on: ''.
coll printOn: emptyStream delimiter: delim last: last.
self assert: emptyStream contents = ''.
coll add: 1.
oneItemStream := ReadWriteStream on: ''.
coll printOn: oneItemStream delimiter: delim last: last.
self assert: oneItemStream contents = '1'.
coll add: 2; add: 3.
multiItemStream := ReadWriteStream on: ''.
coll printOn: multiItemStream delimiter: ', ' last: last.
self assert: multiItemStream contents = '1'', ''2'' & ''3'.]!
----- Method: CollectionTest>>testPrintingArrayWithMetaclass (in category 'testing') -----
testPrintingArrayWithMetaclass
self assert: {Array class} printString = '{Array class}'!
TestCase subclass: #DictionaryTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
DictionaryTest class
instanceVariableNames: 'testToto pt1'!
----- Method: DictionaryTest>>testAdd (in category 'tests') -----
testAdd
| dict |
dict := Dictionary new.
dict add: #a -> 1.
dict add: #b -> 2.
self assert: (dict at: #a) = 1.
self assert: (dict at: #b) = 2!
----- Method: DictionaryTest>>testAddAll (in category 'tests') -----
testAddAll
| dict1 dict2 |
dict1 := Dictionary new.
dict1 at: #a put:1 ; at: #b put: 2.
dict2 := Dictionary new.
dict2 at: #a put: 3 ; at: #c put: 4.
dict1 addAll: dict2.
self assert: (dict1 at: #a) = 3.
self assert: (dict1 at: #b) = 2.
self assert: (dict1 at: #c) = 4.!
----- 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
!
----- Method: DictionaryTest>>testAsSet (in category 'tests') -----
testAsSet
"Non regression test for http://bugs.squeak.org/view.php?id=7258"
| aDictionary aSet assoc0 assoc1 |
"Create a dictionary"
aDictionary := Dictionary new.
"Convert it to a Set"
aSet := aDictionary asSet.
"Add two associations to it"
assoc0 := #first -> 0.
assoc1 := #first -> 1.
aSet add: assoc0 copy; add: assoc1.
"Check if the two associations were added (that should happen if they are different)"
self
assert: (assoc0 copy ~= assoc1) ==> (aSet size > 1)
description:
'When adding two different elements, the set size should be greater than one'!
----- 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]!
----- 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: Error.
self should: [ dict at: #b ] raise: Error.
!
----- 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.
!
----- 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.
self shouldnt: [ dict1 at: nil put: #none] raise: Error.
self assert: (dict1 at: nil) = #none.
!
----- 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!
----- 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.
!
----- 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.!
----- Method: DictionaryTest>>testComma (in category 'tests') -----
testComma
| dict1 dict2 dict3 |
dict1 := Dictionary new.
dict1 at: #a put:1 ; at: #b put: 2.
dict2 := Dictionary new.
dict2 at: #a put: 3 ; at: #c put: 4.
dict3 := dict1, dict2.
self assert: (dict3 at: #a) = 3.
self assert: (dict3 at: #b) = 2.
self assert: (dict3 at: #c) = 4.!
----- 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'.
!
----- 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)).
!
----- 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'
!
----- 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'.
!
----- 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.
self assert: (dict keyAtValue: 1) = #c.
"ugly may be a bug, why not having a set #a and #c"
self should: [dict keyAtValue: 0] raise: Error
!
----- 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)
!
----- 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.
!
----- 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.
!
----- Method: DictionaryTest>>testPseudo (in category 'tests') -----
testPseudo
"(self run: #testPseudo)"
"true and false are valid keys"
| dict1 |
dict1 := Dictionary new.
self shouldnt: [dict1 at: true put: #true] raise: Error.
self assert: (dict1 at: true) = #true.
self shouldnt: [dict1 at: false put: #false] raise: Error.
self assert: (dict1 at: false) = #false.!
----- Method: DictionaryTest>>testPseudoVariablesAreValidKeys (in category 'implementation tests') -----
testPseudoVariablesAreValidKeys
"(self run: #testPseudoVariablesAreValidKeys)"
"true and false are valid keys"
| dict1 |
dict1 := Dictionary new.
self shouldnt: [dict1 at: true put: #true] raise: Error.
self assert: (dict1 at: true) = #true.
self shouldnt: [dict1 at: false put: #false] raise: Error.
self assert: (dict1 at: false) = #false.!
----- 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.!
----- Method: DictionaryTest>>testRemoveAll (in category 'tests') -----
testRemoveAll
"Allows one to remove all elements of a collection"
| dict1 dict2 s2 |
dict1 := Dictionary new.
dict1 at: #a put:1 ; at: #b put: 2.
dict2 := dict1 copy.
s2 := dict2 size.
dict1 removeAll.
self assert: dict1 size = 0.
self assert: dict2 size = s2 description: 'the copy has not been modified'.!
----- 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
!
----- 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"!
----- 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).
!
TestCase subclass: #IdentityBagTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
----- Method: IdentityBagTest>>testIdentity (in category 'tests') -----
testIdentity
"self run:#testIdentity"
"self debug:#testIdentity"
| bag identityBag aString anOtherString |
aString := 'hello'.
anOtherString := aString copy.
self assert: (aString = anOtherString).
self assert: (aString == anOtherString) not.
bag := Bag new.
bag add: aString.
bag add: aString.
bag add: anOtherString.
self assert: (bag occurrencesOf: aString) = 3.
self assert: (bag occurrencesOf: anOtherString) = 3.
identityBag := IdentityBag new.
identityBag add: aString.
identityBag add: aString.
identityBag add: anOtherString.
self assert: (identityBag occurrencesOf: aString) = 2.
self assert: (identityBag occurrencesOf: anOtherString) = 1.
!
TestCase subclass: #RWBinaryOrTextStreamTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Streams'!
----- Method: RWBinaryOrTextStreamTest>>testNextPutAll (in category 'tests') -----
testNextPutAll
| stream |
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'hello'.
self assert: stream contents = 'hello'.
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'hello' asArray.
self assert: stream contents = 'hello'.
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'hello' asByteArray.
self assert: stream contents = 'hello'
!
----- Method: RWBinaryOrTextStreamTest>>testUpTo (in category 'tests') -----
testUpTo
| stream |
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'world'; reset.
self assert: (stream upTo: $r) = 'wo'.
self assert: stream next = $l.
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'hello'; reset.
self assert: (stream upTo: $x) = 'hello'.
self assert: stream atEnd.
stream := RWBinaryOrTextStream on: String new.
stream binary.
stream nextPutAll: 'world'; reset.
self assert: (stream upTo: $r asciiValue) = 'wo' asByteArray.
self assert: stream next = $l asciiValue.
stream := RWBinaryOrTextStream on: String new.
stream binary.
stream nextPutAll: 'hello'; reset.
self assert: (stream upTo: $x asciiValue) = 'hello' asByteArray.
self assert: stream atEnd.
!
----- Method: RWBinaryOrTextStreamTest>>testUpToEnd (in category 'tests') -----
testUpToEnd
| stream |
stream := RWBinaryOrTextStream on: String new.
stream nextPutAll: 'world'; reset.
self assert: stream upToEnd = 'world'.
self assert: stream atEnd.
self assert: stream upToEnd = ''.
self assert: stream atEnd.
stream reset.
stream upTo: $r.
self assert: stream upToEnd = 'ld'.
self assert: stream atEnd.
stream := RWBinaryOrTextStream on: String new.
stream binary.
stream nextPutAll: 'world'; reset.
self assert: stream upToEnd = 'world' asByteArray.
self assert: stream atEnd.
self assert: stream upToEnd = ByteArray new.
self assert: stream atEnd.
stream reset.
stream upTo: $r asciiValue.
self assert: stream upToEnd = 'ld' asByteArray.
self assert: stream atEnd!
TestCase subclass: #RunArrayTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Arrayed'!
----- Method: RunArrayTest>>testAt (in category 'tests - accessing') -----
testAt
"self debug: #testAt"
| array |
array := RunArray new: 5 withAll: 2.
self assert: (array at: 3) = 2.
array at: 3 put: 5.
self assert: (array at: 3) = 5
!
----- Method: RunArrayTest>>testAtPut (in category 'tests - accessing') -----
testAtPut
"self debug: #testAtPut"
| array |
array := RunArray new: 5 withAll: 2.
array at: 3 put: 5.
self assert: array = #(2 2 5 2 2).
array at: 1 put: 1.
self assert: array = #(1 2 5 2 2).!
----- Method: RunArrayTest>>testAtPut2 (in category 'tests - accessing') -----
testAtPut2
"self debug: #testAtPut2"
| array |
array := RunArray new: 5 withAll: 2.
self should: [array at: 0 put: 5] raise: Error.
self should: [array at: 6 put: 5] raise: Error.
self should: [array at: $b put: 5] raise: Error.!
----- Method: RunArrayTest>>testFirst (in category 'tests - accessing') -----
testFirst
"self debug: #testFirst"
| array |
array := RunArray new: 5 withAll: 2.
self assert: array first = 2.
array := #($a $b $c $d) as: RunArray.
self assert: array first = $a.!
----- Method: RunArrayTest>>testLast (in category 'tests - accessing') -----
testLast
"self debug: #testLast"
| array |
array := RunArray new: 5 withAll: 2.
self assert: array last = 2.
array := #($a $b $c $d) as: RunArray.
self assert: array last = $d.!
----- Method: RunArrayTest>>testNew (in category 'tests - instance creation') -----
testNew
"self debug: #testNew"
| array |
array := RunArray new.
self assert: array size = 0.!
----- Method: RunArrayTest>>testNewFrom (in category 'tests - instance creation') -----
testNewFrom
"self debug: #testNewFrom"
| array |
array := RunArray newFrom: #($a $b $b $b $b $c $c $a).
self assert: array size = 8.
self assert: array = #($a $b $b $b $b $c $c $a).!
----- Method: RunArrayTest>>testNewWithAll (in category 'tests - instance creation') -----
testNewWithAll
"self debug: #testNewWithAll"
| array |
array := RunArray new: 5 withAll: 2.
self assert: array size = 5.
self assert: array = #(2 2 2 2 2)!
----- Method: RunArrayTest>>testNewWithSize (in category 'tests - instance creation') -----
testNewWithSize
|array|
array := RunArray new: 5.
self assert: array size = 5.
1 to: 5 do: [:index | self assert: (array at: index) isNil]!
----- Method: RunArrayTest>>testRunLengthAt (in category 'tests - accessing') -----
testRunLengthAt
"self debug: #testRunLengthAt"
| array |
array := #($a $b $b $c $c $c $d $d) as: RunArray.
self assert: (array runLengthAt: 1) = 1.
self assert: (array runLengthAt: 2) = 2.
self assert: (array runLengthAt: 3) = 1.
self assert: (array runLengthAt: 4) = 3.
self assert: (array runLengthAt: 5) = 2.
self assert: (array runLengthAt: 6) = 1.
self assert: (array runLengthAt: 7) = 2.
self assert: (array runLengthAt: 8) = 1.!
----- Method: RunArrayTest>>testRunsValues (in category 'tests - instance creation') -----
testRunsValues
"self debug: #testRunsValues"
| array |
array := RunArray runs: #(1 4 2 1) values: #($a $b $c $a).
self assert: array size = 8.
self assert: array = #($a $b $b $b $b $c $c $a).!
----- Method: RunArrayTest>>testScanFromANSICompatibility (in category 'tests - instance creation') -----
testScanFromANSICompatibility
"self run: #testScanFromANSICompatibility"
RunArray scanFrom: (ReadStream on: '()f1dNumber new;;').
RunArray scanFrom: (ReadStream on: '()a1death;;').
RunArray scanFrom: (ReadStream on: '()F1death;;').!
----- Method: RunArrayTest>>testWithStartStopAndValueDo (in category 'tests - accessing') -----
testWithStartStopAndValueDo
"self debug: #testWithStartStopAndValueDo"
| array elements startStops |
array := #($a $b $b $c $c $c $d $d) as: RunArray.
elements := OrderedCollection new.
startStops := OrderedCollection new.
array withStartStopAndValueDo: [:start :stop :value | elements add: value. startStops add: start->stop].
self assert: elements asArray = #($a $b $c $d).
self assert: startStops asArray = {1->1 . 2->3 . 4->6 . 7->8}!
TestCase subclass: #SharedQueue2Test
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
----- 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 ].
!
----- 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 ].
!
----- 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 ].
!
TestCase subclass: #SortedCollectionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
----- Method: SortedCollectionTest>>testAdd (in category 'basic') -----
testAdd
"self run: #testAdd"
"self debug: #testAdd"
| collection |
collection := #(10 9 8 7 5 4 4 2) asSortedCollection.
self assert: collection first = 2.
self assert: collection last = 10.
self assert: (collection size = 8).
collection add:1.
self assert: (collection size = 9).
collection add: 6.
self assert: ((collection at: 5) = 5).
self assert: (collection size = 10).
collection add: 3.
!
----- Method: SortedCollectionTest>>testAddAll (in category 'basic') -----
testAddAll
"self run: #testAddAll"
"self debug: #testAddAll"
| sorted2 sorted|
sorted2 := SortedCollection new.
sorted2 add: 'brochet'; add:'truitelle'.
sorted := SortedCollection new.
sorted addAll: sorted2.
self assert: (sorted hasEqualElements: sorted2).
!
----- Method: SortedCollectionTest>>testAddAll2 (in category 'basic') -----
testAddAll2
"self run: #testAddAll2"
"self debug: #testAddAll2"
| sorted2 sorted|
sorted2 := SortedCollection new.
sorted2 add: 'brochet'; add:'truitelle'.
sorted := SortedCollection new.
sorted add: 'perche'.
sorted addAll: sorted2.
self assert: (sorted size = (sorted2 size + 1)).
sorted2 do:
[ :each | self assert: (sorted includes: each)]
!
----- Method: SortedCollectionTest>>testCollect (in category 'basic') -----
testCollect
"self run: #testCollect"
|result aSortedCollection|
aSortedCollection := SortedCollection new.
result := OrderedCollection new.
result add:true ; add: true ; add: true ;add: false ; add: false.
aSortedCollection := (1 to: 5) asSortedCollection.
self assert: (result = (aSortedCollection collect: [:each | each < 4])).
!
----- Method: SortedCollectionTest>>testCopy (in category 'basic') -----
testCopy
"self run: #testCopy"
"self debug: #testCopy"
|aSortedCollection copySorted|
aSortedCollection := SortedCollection new.
aSortedCollection sortBlock: [:a :b | a < b].
aSortedCollection add: 'truite' ; add: 'brochet'.
self assert: aSortedCollection first = 'brochet'.
copySorted := aSortedCollection copy.
self assert: (copySorted hasEqualElements: aSortedCollection).
self assert: (copySorted species = aSortedCollection species).
self assert: (copySorted sortBlock = aSortedCollection sortBlock).
self assert: copySorted first = 'brochet'.!
----- Method: SortedCollectionTest>>testCreation (in category 'basic') -----
testCreation
"self run: #testCreation"
"self debug: #testCreation"
| collection |
collection := #(10 9 3 6 1 8 7 5 4 2) asSortedCollection.
self assert: collection = (1 to: 10) asSortedCollection.
!
----- Method: SortedCollectionTest>>testEquals (in category 'basic') -----
testEquals
"self run: #testEquals"
"self debug: #testEquals"
|aSortedCollection|
aSortedCollection := SortedCollection new.
aSortedCollection add:'truite' ; add: 'brochet'.
self assert: aSortedCollection copy = aSortedCollection.!
----- Method: SortedCollectionTest>>testMedian (in category 'basic') -----
testMedian
"self run: #testMedian"
"self debug: #testMedian"
|aSortedCollection|
aSortedCollection := (1 to: 10) asSortedCollection.
self assert: aSortedCollection median=5.
aSortedCollection := SortedCollection new.
aSortedCollection add:'truite' ; add:'porcinet' ; add:'carpe'.
self assert: (aSortedCollection median = 'porcinet').
!
----- Method: SortedCollectionTest>>testRemoveAll (in category 'basic') -----
testRemoveAll
"Allows one to remove all elements of a collection"
| c1 c2 s2 |
c1 := #(10 9 8 7 5 4 4 2) asSortedCollection: [:a :b | a >= b].
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'.
c1 add: 13; add: 14.
self assert: (c1 first = 14 and: [c1 second = 13]) description: 'the sortBlock has been preserved'.!
----- Method: SortedCollectionTest>>testReversed (in category 'basic') -----
testReversed
| sc1 sc2 sc3 |
sc1 := #(1 2 3 4) asSortedCollection.
self assert: sc1 reversed asArray = sc1 asArray reversed.
self
assert: sc1 reversed class = SortedCollection
description: 'reversing a SortedCollection should answer a SortedCollection'.
sc1 removeFirst; removeLast.
sc2 := sc1 reversed.
self assert: sc2 reversed asArray = sc1 asArray.
sc2 add: 3/2; add: 1/2; add: 7/2.
self assert: sc2 asArray = {7/2. 3. 2. 3/2. 1/2}.
sc3 := #(1 2 3 3.0 4) asSortedCollection.
self assert: sc3 reversed asArray = #(4 3.0 3 2 1).
self assert: (sc3 reversed at: 2) class = Float.
!
----- Method: SortedCollectionTest>>testShouldPrecede (in category 'basic') -----
testShouldPrecede
"self run: #testShouldPrecede"
|aSortedCollection|
aSortedCollection := SortedCollection new.
self assert: (aSortedCollection should: 'za' precede: 'zb').
self assert: (aSortedCollection isEmpty).
self assert: (aSortedCollection should: 1 precede: 2).
aSortedCollection sortBlock: [:a :b | a > b].
aSortedCollection reSort.
self assert: (aSortedCollection should: 'zb' precede: 'za').
self assert: (aSortedCollection isEmpty).
self assert: (aSortedCollection should: 2 precede: 1).
!
----- Method: SortedCollectionTest>>testSortBlock (in category 'basic') -----
testSortBlock
"self run: #testSortBlock"
"self debug: #testSortBlock"
|aSortedCollection|
aSortedCollection := SortedCollection new.
aSortedCollection sortBlock: [:a :b | a < b].
aSortedCollection add: 'truite' ; add: 'brochet' ; add: 'tortue'.
self assert: aSortedCollection first = 'brochet'.
aSortedCollection := SortedCollection new.
aSortedCollection sortBlock: [:a :b | a >b].
aSortedCollection add: 'truite' ; add: 'brochet' ; add: 'tortue'.
self assert: aSortedCollection first = 'truite'.
!
----- Method: SortedCollectionTest>>testSpeciesLooseSortBlock (in category 'basic') -----
testSpeciesLooseSortBlock
"This is a non regression test for http://bugs.squeak.org/view.php?id=6535"
| numbers reverseOrder firstThree |
numbers := #(1 2 3 4 5).
reverseOrder := SortedCollection sortBlock: [:x :y | x > y].
reverseOrder addAll: numbers.
"The elements are inverted"
self assert: [reverseOrder asArray = #(5 4 3 2 1)].
"Copy the first 3 elements"
firstThree := reverseOrder copyFrom: 1 to: 3.
"It appears to work"
self assert: [firstThree asArray = #(5 4 3)].
"but we have lost the sort block"
firstThree add: 1.
" firstThree is now #(1 5 4 3)!! "
self assert: [firstThree asArray = #(5 4 3 1)] "fails"!
TestCase subclass: #StackTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Stack'!
StackTest class
instanceVariableNames: 'testSize'!
----- 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 shouldnt: [ aStack top ] raise: Error.
self shouldnt: [ aStack pop] raise: Error.
"The stack is empty again due to previous pop"
self should: [ aStack top ] raise: Error.
self should: [ aStack pop] raise: Error.!
----- 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.
!
----- 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.
!
----- 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.
!
----- 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.!
TestCase subclass: #TextAndTextStreamTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!TextAndTextStreamTest commentStamp: '<historical>' prior: 0!
At May 09, 2003 Tim Olson sent a bug report to the Squeak developers list that inspired me to examine the protocol of TextStream in greater detail. (The bug that Tim reported was present in Squeak 3.4, it is shown in testExample1.) In a discussion that followed, Daniel Vainsencher proposed that we should have tests for Text and TextStreams. This class is an attempt to implement that proposal. For Squeak 3.4, some of the test examples fail.!
----- Method: TextAndTextStreamTest>>example1: (in category 'examples') -----
example1: size
| ts text |
ts := TextStream on: (Text new: size).
ts nextPutAll: 'xxxxx' asText.
ts nextPutAll: ('yyyyy' asText allBold, 'zzzzzzz' asText).
text := ts contents.
^text
!
----- Method: TextAndTextStreamTest>>example2 (in category 'examples') -----
example2
| ts text |
ts := TextStream on: (Text new: 50).
ts nextPutAll: 'abc' asText.
ts nextPutAll: 'def' asText allBold.
ts nextPutAll: 'ghijk' asText.
text := ts contents.
^text
!
----- Method: TextAndTextStreamTest>>replacementAtStartExample3 (in category 'examples') -----
replacementAtStartExample3
| text1 replacement length |
text1 := 'This is a simple text' copy asText.
" without the copy, we would modify a constant that the compiler attached at the compiled method. "
length := 'This' size.
replacement := 'Tht' asText.
text1 replaceFrom: 1
to: length
with: replacement
startingAt: 1.
!
----- Method: TextAndTextStreamTest>>replacementExample3 (in category 'examples') -----
replacementExample3
" for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement
Here, the replacement text is shorteer than the text that is shall replace. "
| text1 string replacement startPos length startPosInRep string2 |
text1 := (string := 'This is again simple text' copy) asText.
" without the copy, we would modify a constant that the compiler attached at the compiled method. "
startPos := string findString: 'simple'.
length := 'simple' size.
replacement := (string2 := 'both simple and short') asText.
startPosInRep := string2 findString: 'short'.
text1 replaceFrom: startPos
to: startPos + length - 1
with: replacement
startingAt: startPosInRep.
!
----- Method: TextAndTextStreamTest>>testAddStringToTextStream (in category 'tests') -----
testAddStringToTextStream
"It is possible to add a string into a TextStream.
This test verifies that the created text has text attributes for all its characters. "
| ts text |
ts := TextStream on: (Text new: 50).
ts nextPutAll: 'abc' asText.
ts nextPutAll: 'def' asText allBold.
ts nextPutAll: 'ghijk'.
text := ts contents.
" now, check the fundamental invariant of a text: "
self assert: text string size = text runs size.
!
----- Method: TextAndTextStreamTest>>testExampleText1 (in category 'tests') -----
testExampleText1
"self run: #testExampleText1"
"inspired by a bug report from Tim Olson.
Text attributes are lost when the stream collection is expanded.
Documented BUG!!!!!!"
| text1 text2 atts1 atts2 |
text1 := self example1: 10. " here we will loose the attribute bold "
text2 := self example1: 50. " here we have a larger buffer and will not loose text attributes "
atts1 := text1 runs copyFrom: 6 to: 10.
atts2 := text2 runs copyFrom: 6 to: 10.
self assert: atts1 = atts2.
!
----- Method: TextAndTextStreamTest>>testExampleText2 (in category 'tests') -----
testExampleText2
"a Text looses its attributes when it is reversed "
| text1 text2 |
text1 := self example2.
text2 := text1 reversed reversed.
self assert: text1 runs = text2 runs.
!
----- Method: TextAndTextStreamTest>>testRunArrayAdjacentMerge (in category 'tests') -----
testRunArrayAdjacentMerge
"this demonstrates that adjancent runs with equal attributes are merged. "
| runArray |
runArray := RunArray new.
runArray
addLast: TextEmphasis normal times: 5;
addLast: TextEmphasis bold times: 5;
addLast: TextEmphasis bold times: 5.
self assert: (runArray runs size = 2). !
----- Method: TextAndTextStreamTest>>testRunArrayInvariant (in category 'tests') -----
testRunArrayInvariant
"this verifies that the fundamental invariant of a RunArray is always satisfied. "
"see comment below"
| runArray |
runArray := RunArray new.
runArray
addLast: TextEmphasis normal times: 5;
addLast: TextEmphasis bold times: 5;
addLast: TextEmphasis normal times: 5.
self assert:
((1 to: runArray size) allSatisfy:
[:idx | | lastIndex lastOffset lastRun lengthOfPreviousRuns |
runArray at: idx. " updates the cached values "
lastIndex := runArray instVarNamed: 'lastIndex'.
lastRun := runArray instVarNamed: 'lastRun'.
lastOffset := runArray instVarNamed: 'lastOffset'.
lengthOfPreviousRuns
:= (1 to: lastRun - 1)
inject: 0
into: [:sum :idx2 | sum + (runArray runs at: idx2)].
lastIndex = (lastOffset + lengthOfPreviousRuns + 1)
]
).
" This method is a bit tricky. First, it uses Object>>instVarNamed: to access instance variables for which no accessors are defined. The same method is used by the debuggers and by various inspectors.
The assertion itself explains the meaning of the cached values."!
----- Method: TextAndTextStreamTest>>testRunArrayReversal (in category 'tests') -----
testRunArrayReversal
"this tests the reversal of a RunArray "
| runArray |
runArray := RunArray new.
runArray
addLast: TextEmphasis normal times: 5;
addLast: TextEmphasis bold times: 5;
addLast: TextEmphasis normal times: 5.
self assert: (runArray reversed runs size = 3). !
----- Method: TextAndTextStreamTest>>testRunArrayRunsAreNotMerged (in category 'tests') -----
testRunArrayRunsAreNotMerged
" this demonstrates that different runs are not merged "
| runArray |
runArray := RunArray new.
runArray
addLast: TextEmphasis normal times: 5;
addLast: TextEmphasis bold times: 5;
addLast: TextEmphasis normal times: 5.
self assert: (runArray runs size = 3). !
----- Method: TextAndTextStreamTest>>testRunArrayRunsSize (in category 'tests') -----
testRunArrayRunsSize
"this demonstrates that the size of a run array is the sum of the sizes of its runs. "
| runArray |
runArray := RunArray new.
runArray
addLast: TextEmphasis normal times: 5;
addLast: TextEmphasis bold times: 5;
addLast: TextEmphasis normal times: 5.
self assert: (runArray size = 15). !
----- Method: TextAndTextStreamTest>>testTextEmphasisRangeDetection1 (in category 'tests') -----
testTextEmphasisRangeDetection1
"this tests the detection of the range of a text attribute. "
| text startPos boldStyle |
text := 'This is a text with attriute bold for some characters' asText.
startPos := text findString: 'bold' startingAt: 1.
text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
boldStyle := TextEmphasis bold.
" uncomment the following statement for examine failures: "
" -----------------
(1 to: text size) do:
[:idx | | range |
range := text rangeOf: boldStyle startingAt: idx.
Transcript show: startPos; show: ' -- '; show: idx printString; show: ' '; show: range printString; show: range size printString; show: ((idx between: startPos and: startPos + 3)
ifTrue:
[range first = startPos & (range size = 4)]
ifFalse:
[range first = idx & (range size = 0)]) printString; cr.
].
------------- "
self assert:
((1 to: text size) allSatisfy:
[:idx | | range |
range := text rangeOf: boldStyle startingAt: idx.
(idx between: startPos and: startPos + 3)
ifTrue: [range first = startPos & (range size = 4)]
ifFalse: [range first = idx & (range size = 0)]])!
----- Method: TextAndTextStreamTest>>testTextEmphasisRangeDetection2 (in category 'tests') -----
testTextEmphasisRangeDetection2
"this tests the detection of the range of a text attribute.
Here the searched attribute spans three runs. The objective of the test is whether the entire range is always found."
| text startPos searchedStyle |
text := 'This is a text with attriute bold for some characters' asText.
startPos := text findString: 'bold' startingAt: 1.
text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
text addAttribute: TextEmphasis italic from: startPos - 2 to: startPos + 5.
searchedStyle := TextEmphasis italic.
" uncomment the following statement for examine failures: "
" -----------------------
(1 to: text size) do:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
Transcript show: startPos; show: ' -- '; show: idx printString; show: ' '; show: range printString; show: range size printString; show: ((idx between: startPos - 2 and: startPos -2 + 7)
ifTrue:
[range first = (startPos - 2) & (range size = 8)]
ifFalse:
[range first = idx & (range size = 0)]) printString; cr.
].
----------------------- "
self assert:
((1 to: text size) allSatisfy:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
(idx between: startPos - 2 and: startPos -2 + 7)
ifTrue: [range first = (startPos - 2) & (range size = 8)]
ifFalse: [range first = idx & (range size = 0)]])!
----- Method: TextAndTextStreamTest>>testTextEmphasisRangeDetection3 (in category 'tests') -----
testTextEmphasisRangeDetection3
"this tests the detection of the range of a text attribute.
Here the searched attribute spans three runs. The the range to be detected begins at text position 1. The objective of the test is whether the entire range is always found."
| text startPos searchedStyle |
text := 'This is a text with attriute bold for some characters' asText.
startPos := text findString: 'bold' startingAt: 1.
text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
text addAttribute: TextEmphasis italic from: 1 to: startPos + 5.
searchedStyle := TextEmphasis italic.
" uncomment the following statement to examine failures: "
" -----------------------
(1 to: text size) do:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
Transcript show: startPos;
show: ' -- ';
show: idx printString;
show: ' ';
show: range printString;
show: range size printString;
show: ' ';
show: ((idx between: 1 and: startPos + 5)
ifTrue:
[range first = 1 & (range size = (startPos + 5))]
ifFalse:
[range first = idx & (range size = 0)]) printString; cr.
].
----------------------- "
self assert:
((1 to: text size) allSatisfy:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
(idx between: 1 and: startPos + 5)
ifTrue:
[range first = 1 & (range size = (startPos + 5))]
ifFalse:
[range first = idx & (range size = 0)]])!
----- Method: TextAndTextStreamTest>>testTextEmphasisRangeDetection4 (in category 'tests') -----
testTextEmphasisRangeDetection4
"this tests the detection of the range of a text attribute.
Here the searched attribute spans three runs. The the range to be detected extends to the end of the text . The objective of the test is whether the
entire range is always found."
| text startPos searchedStyle |
text := 'This is a text with attriute bold for some characters' asText.
startPos := text findString: 'bold' startingAt: 1.
text addAttribute: TextEmphasis bold from: startPos to: startPos + 3.
text addAttribute: TextEmphasis italic from: startPos - 2 to: text size.
searchedStyle := TextEmphasis italic.
" uncomment the following statement to examine failures: "
" -----------------------------------------
(1 to: text size) do:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
Transcript show: startPos;
show: ' -- ';
show: idx printString;
show: ' ';
show: range printString;
show: range size printString;
show: ' ';
show: ((idx between: startPos - 2 and: text size)
ifTrue:
[range first = (startPos - 2) & (range size = (text size - (startPos - 2) + 1))]
ifFalse:
[range first = idx & (range size = 0)]) printString;
cr.
].
-------------------------------"
self assert:
((1 to: text size) allSatisfy:
[:idx | | range |
range := text rangeOf: searchedStyle startingAt: idx.
(idx between: startPos - 2 and: text size)
ifTrue: [range first = (startPos - 2) & (range size = (text size - (startPos - 2) + 1))]
ifFalse: [range first = idx & (range size = 0)]])!
----- Method: TextAndTextStreamTest>>testTextReplacement1 (in category 'tests') -----
testTextReplacement1
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement "
| text1 string replacement startPos length startPosInRep string2 |
text1 := (string := 'This is a simple text' copy) asText.
"without the copy, we would modify a constant that the compiler attached at the compiled method. "
startPos := string findString: 'simple'.
length := 'simple' size.
replacement := (string2 := 'both simple and short*') asText.
startPosInRep := string2 findString: 'short'.
text1 replaceFrom: startPos
to: startPos + length - 1
with: replacement
startingAt: startPosInRep.
self assert: text1 string size = text1 runs size.
!
----- Method: TextAndTextStreamTest>>testTextReplacement2 (in category 'tests') -----
testTextReplacement2
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement.
Here, the replacement text has trailing characters. "
| text1 string replacement startPos length startPosInRep string2 |
text1 := (string := 'This is simple text' copy) asText.
"without the copy, we would modify a constant that the compiler attached at the compiled method. "
startPos := string findString: 'simple'.
length := 'simple' size.
replacement := (string2 := 'both simple and short*************') asText.
startPosInRep := string2 findString: 'short'.
text1 replaceFrom: startPos
to: startPos + length - 1
with: replacement
startingAt: startPosInRep.
self assert: text1 string size = text1 runs size.
!
----- Method: TextAndTextStreamTest>>testTextReplacement3 (in category 'tests') -----
testTextReplacement3
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement
Here, the replacement text is shorteer than the text that is shall replace. "
self should: [self replacementExample3] raise: Error!
----- Method: TextAndTextStreamTest>>testTextReplacementAtStartPos1 (in category 'tests') -----
testTextReplacementAtStartPos1
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement "
| text1 replacement length |
text1 := 'This is a simple text' copy asText.
"without the copy, we would modify a constant that the compiler attached at the compiled method. "
length := 'This' size.
replacement := 'That' asText.
text1 replaceFrom: 1
to: length
with: replacement
startingAt: 1.
self assert: text1 string size = text1 runs size.
!
----- Method: TextAndTextStreamTest>>testTextReplacementAtStartPos2 (in category 'tests') -----
testTextReplacementAtStartPos2
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement "
| text1 replacement length |
text1 := 'This is a simple text' copy asText.
"without the copy, we would modify a constant that the compiler attached at the compiled method. "
length := 'This' size.
replacement := 'That********' asText.
text1 replaceFrom: 1
to: length
with: replacement
startingAt: 1.
self assert: text1 string size = text1 runs size.
!
----- Method: TextAndTextStreamTest>>testTextReplacementAtStartPos3 (in category 'tests') -----
testTextReplacementAtStartPos3
"for a Text t,
the following assertion should always hold:
t string size = t run size
This test examines the preservation of this assertion for in-place replacement
Here, the replacement text is shorteer than the text that is shall replace. "
self should: [self replacementAtStartExample3] raise: Error!
----- Method: TextAndTextStreamTest>>testTextStreamAdjacentRunsWithIdentitcalAttributes (in category 'tests') -----
testTextStreamAdjacentRunsWithIdentitcalAttributes
"This test verifies that adjacent runs with identical attributes are coalesced."
| ts text rangeOfBold |
ts := TextStream on: (Text new: 50).
ts nextPutAll: 'abc' asText.
ts nextPutAll: 'def' asText allBold.
ts nextPutAll: 'ghijk'.
text := ts contents.
rangeOfBold := text find: TextEmphasis bold.
text removeAttribute: TextEmphasis bold from: rangeOfBold first to: rangeOfBold last.
"now, check that only one run is left and that it has the correct size "
self assert: text runs runs size = 1 & (text runs size = text string size).
!
TestCase subclass: #TextLineEndingsTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!TextLineEndingsTest commentStamp: 'nk 11/1/2003 07:55' prior: 0!
This is a test case for Text>>withSqueakLineEndings and String>>withSqueakLineEndings.
The main problem we've seen with the Text version is that it doesn't preserve formatting correctly.!
----- Method: TextLineEndingsTest>>testDecoratedTextConversionCrLF (in category 'tests') -----
testDecoratedTextConversionCrLF
| text newText |
text := ('123456', String crlf, '901234') asText.
text addAttribute: TextColor blue from: 4 to: 10.
text addAttribute: TextColor red from: 6 to: 9.
text addAttribute: TextEmphasis bold.
newText := text withSqueakLineEndings.
self assert: ((text size - 1) = newText size).
self assert: (newText size = newText runs size).
self assert: (newText attributesAt: 6) = (text attributesAt: 6).
self assert: (newText attributesAt: 8) = (text attributesAt: 9).!
----- Method: TextLineEndingsTest>>testDecoratedTextConversionJustLF (in category 'tests') -----
testDecoratedTextConversionJustLF
| text newText |
text := ('123456', String lf, '901234') asText.
text addAttribute: TextColor blue from: 4 to: 10.
text addAttribute: TextColor red from: 6 to: 9.
text addAttribute: TextEmphasis bold.
newText := text withSqueakLineEndings.
self assert: ((text size) = newText size).
self assert: (newText size = newText runs size).
self assert: (newText attributesAt: 6) = (text attributesAt: 6).
self assert: (newText attributesAt: 8) = (text attributesAt: 8).!
----- Method: TextLineEndingsTest>>testDecoratedTextConversionNoLF (in category 'tests') -----
testDecoratedTextConversionNoLF
| text newText |
text := ('123456', String cr, '901234') asText.
text addAttribute: TextColor blue from: 4 to: 10.
text addAttribute: TextColor red from: 6 to: 9.
text addAttribute: TextEmphasis bold.
newText := text withSqueakLineEndings.
self assert: ((text size) = newText size).
self assert: (newText size = newText runs size).
self assert: (newText attributesAt: 6) = (text attributesAt: 6).
self assert: (newText attributesAt: 8) = (text attributesAt: 8).!
----- Method: TextLineEndingsTest>>testSimpleTextConversionCrLF (in category 'tests') -----
testSimpleTextConversionCrLF
| string newText |
string := 'This is a test', String crlf, 'of the conversion'.
newText := string asText withSqueakLineEndings.
self assert: ((string size - 1) = newText size).
self assert: (newText size = newText runs size).!
----- Method: TextLineEndingsTest>>testSimpleTextConversionJustCR (in category 'tests') -----
testSimpleTextConversionJustCR
| string newText |
string := 'This is a test', String cr, 'of the conversion'.
newText := string asText withSqueakLineEndings.
self assert: ((string size) = newText size).
self assert: (newText size = newText runs size).!
----- Method: TextLineEndingsTest>>testSimpleTextConversionJustLF (in category 'tests') -----
testSimpleTextConversionJustLF
| string newText |
string := 'This is a test', String lf, 'of the conversion'.
newText := string asText withSqueakLineEndings.
self assert: ((string size) = newText size).
self assert: (newText size = newText runs size).!
----- Method: TextLineEndingsTest>>testStringConversionCrLF (in category 'tests') -----
testStringConversionCrLF
| string newString |
string := 'This is a test', String crlf, 'of the conversion'.
newString := string withSqueakLineEndings.
self assert: ((string size - 1) = newString size).!
----- Method: TextLineEndingsTest>>testStringConversionJustLF (in category 'tests') -----
testStringConversionJustLF
| string newString |
string := 'This is a test', String lf, 'of the conversion'.
newString := string withSqueakLineEndings.
self assert: (string size = newString size).!
----- Method: TextLineEndingsTest>>testStringConversionNoLF (in category 'tests') -----
testStringConversionNoLF
| string newString |
string := 'This is a test', String cr, 'of the conversion'.
newString := string withSqueakLineEndings.
self assert: (string = newString).!
TestCase subclass: #WideCharacterSetTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Support'!
!WideCharacterSetTest commentStamp: 'nice 11/19/2007 22:45' prior: 0!
WideCharacterSetTest holds tests for WideCharacterSet!
----- 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 should: [wcs size = (cs size + 1)] description: 'We just added a Character, size should be increased by one'.
self shouldnt: [wcs = cs] description: 'We just added a Character, sets should not be equal'.
self shouldnt: [cs = wcs] description: 'We just added a Character, sets should not be equal'.
self should: [cs allSatisfy: [:char | wcs includes: char]] description: 'Each character of the original CharacterSet should be included in the WideCharacterSet'.
self should: [wcs hasWideCharacters] description: 'We just added a WideCharacter, so this WideCharacterSet definitely has one'.
self should: [wcs includes: wc] description: 'We just added this WideCharacter, so this WideCharacterSet should include it'.
wcs add: wc.
self should: [wcs size = (cs size + 1)] description: 'We just added a Character already included in the set, size should be unchanged'.
wcs remove: wc.
self should: [wcs size = cs size] description: 'We added then removed a Character, now size should be equal to original'.
self shouldnt: [wcs hasWideCharacters] description: 'We just removed the only WideCharacter, so this WideCharacterSet definitely has no WideCharacter'.
self should: [wcs = cs] description: 'A WideCharacterSet can be equal to an Ordinary CharacterSet'.
self should: [cs = wcs] description: 'An ordinary CharacterSet can be equal to a WideCharacterSet'.
self should: [cs hash = wcs hash] description: 'If some objects are equal, then they should have same hash code'.
!
----- 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 should: [wcs1 = cs1].
self should: [wcs1 size = byteString "asSet" size].
cs2 := CharacterSet newFrom: wideString.
wcs2 := WideCharacterSet newFrom: wideString.
self should: [wcs2 = cs2].
self should: [wcs2 size = wideString "asSet" size].
self should: [(byteString indexOfAnyOf: wcs1) = 1] description: 'This should used optimized byteArrayMap method'.
self should: [(byteString indexOfAnyOf: wcs2) = 1] description: 'This should used optimized byteArrayMap method'.
self should: [('bcd' indexOfAnyOf: wcs1) = 0] description: 'This should used optimized byteArrayMap method'.
self should: [('bcd' indexOfAnyOf: wcs2) = 0] description: 'This should used optimized byteArrayMap method'.!
----- Method: ReadStreamTest>>classUnderTest (in category 'accessing') -----
classUnderTest
^ ReadStream!
----- Method: ReadStreamTest>>emptyStream (in category 'accessing - defaults') -----
emptyStream
^ ReadStream on: String new.!
----- Method: ReadStreamTest>>streamOn:upToAll: (in category 'helpers') -----
streamOn: collection upToAll: subcollection
^ (self streamOn: collection) upToAll: subcollection!
----- Method: ReadStreamTest>>streamOn:upToAll:upToAll: (in category 'helpers') -----
streamOn: collection upToAll: subcollection1 upToAll: subcollection2
^(self streamOn: collection)
upToAll: subcollection1;
upToAll: subcollection2!
----- Method: ReadStreamTest>>streamOnArray (in category 'accessing - defaults') -----
streamOnArray
^ ReadStream on: (Array with: 1 with: #(a b c) with: false).!
----- Method: ReadStreamTest>>streamOnString (in category 'accessing - defaults') -----
streamOnString
^ ReadStream on: 'abcde'.!
----- Method: ReadStreamTest>>testIsEmpty (in category 'tests - testing') -----
testIsEmpty
| stream |
self assert: self emptyStream isEmpty.
stream := self streamOnArray.
self deny: stream isEmpty.
stream skip: 3.
self deny: stream isEmpty.
stream := self streamOnString.
self deny: stream isEmpty.
stream next;next;next.
self deny: stream isEmpty.
stream setToEnd.
self deny: stream isEmpty.!
----- Method: ReadStreamTest>>testPositionOfSubCollection (in category 'tests - positioning') -----
testPositionOfSubCollection
self assert: ((self streamOn: 'xyz') positionOfSubCollection: 'q' ) = 0.
self assert: ((self streamOn: 'xyz') positionOfSubCollection: 'x' ) = 1.
self assert: ((self streamOn: 'xyz') positionOfSubCollection: 'y' ) = 2.
self assert: ((self streamOn: 'xyz') positionOfSubCollection: 'z' ) = 3.!
----- Method: ReadStreamTest>>testUpToAll (in category 'tests - accessing') -----
testUpToAll
self assert: (self streamOn: 'abcdefgh' upToAll: 'cd') = 'ab'.
self assert: (self streamOn: 'abcdefgh' upToAll: 'cd' upToAll: 'gh') = 'ef'.
self assert: (self streamOn: '' upToAll: '') = ''.
self assert: (self streamOn: 'a' upToAll: '') = ''.
self assert: (self streamOn: 'a' upToAll: 'a') = ''.
self assert: (self streamOn: 'a' upToAll: 'b') = 'a'.
self assert: (self streamOn: 'ab' upToAll: '') = ''.
self assert: (self streamOn: 'ab' upToAll: 'a') = ''.
self assert: (self streamOn: 'ab' upToAll: 'b') = 'a'.
self assert: (self streamOn: 'ab' upToAll: 'c') = 'ab'.
self assert: (self streamOn: 'ab' upToAll: 'ab') = ''.
self assert: (self streamOn: 'abc' upToAll: '') = ''.
self assert: (self streamOn: 'abc' upToAll: 'a') = ''.
self assert: (self streamOn: 'abc' upToAll: 'b') = 'a'.
self assert: (self streamOn: 'abc' upToAll: 'c') = 'ab'.
self assert: (self streamOn: 'abc' upToAll: 'd') = 'abc'.
self assert: (self streamOn: 'abc' upToAll: 'ab') = ''.
self assert: (self streamOn: 'abc' upToAll: 'bc') = 'a'.
self assert: (self streamOn: 'abc' upToAll: 'cd') = 'abc'.
!
----- Method: TReadStreamTest>>testContents2 (in category 'tests - accessing') -----
testContents2
"From ANSI Smalltalk Standard draft 1.9:
it is unspecified whether or not the returned collection [using #contents] is the same object as the backing store collection. However, if the returned collection is not the same object as the stream backing store collection then the class of the returned collection is the same class as would be returned if the message #select: was sent to the backing store collection."
"In Squeak, there is #species to know what class should be used on copy, selection..."
| interval stream streamContents |
interval := 1 to: 32.
stream := self streamOn: interval.
streamContents := stream contents.
(streamContents == interval)
ifFalse: [self assert: streamContents class = Interval new species]!
----- Method: TReadStreamTest>>testNew (in category 'tests - instance creation') -----
testNew
self should: [self classUnderTest new] raise: Error.!
----- Method: TReadStreamTest>>testOn (in category 'tests - instance creation') -----
testOn
self shouldnt: [self streamOn: ' '] raise: Error.
self assert: (self streamOn: ' ') position isZero.!
----- Method: TReadStreamTest>>testPosition (in category 'tests - positioning') -----
testPosition
| stream |
self assert: self emptyStream position isZero.
stream := self streamOnArray.
self assert: stream position = 0.
stream next.
self assert: stream position = 1.
stream next.
self assert: stream position = 2.
stream next.
self assert: stream position = 3.
stream next.
self assert: stream position = 3.
stream next.
self assert: stream position = 3.!
----- Method: TGettableStreamTest>>testAtEnd (in category 'tests - testing') -----
testAtEnd
| stream |
self assert: self emptyStream atEnd.
stream := self streamOnArray.
self deny: stream atEnd.
stream next: 3.
self assert: stream atEnd.!
----- Method: TGettableStreamTest>>testBack (in category 'tests - back') -----
testBack
"Test the new implemtation of the method back."
|stream|
stream := self streamOn: 'abc'.
stream next: 2.
self assert: stream back = $b.!
----- Method: TGettableStreamTest>>testBackOnPosition1 (in category 'tests - back') -----
testBackOnPosition1
"Test the new implemtation of the method back."
|stream|
stream := self streamOn: 'abc'.
stream next.
self assert: stream back = $a.!
----- Method: TGettableStreamTest>>testDo (in category 'tests - enumerating') -----
testDo
self emptyStream do: [:value | self fail]!
----- Method: TGettableStreamTest>>testDo2 (in category 'tests - enumerating') -----
testDo2
| stream string |
stream := self streamOnArray.
string := String new.
stream do: [:value | string := string, ' ', value asString].
self assert: string = (' ', 1 asString, ' ', #(a b c) asString, ' ', false asString)!
----- Method: TGettableStreamTest>>testNext (in category 'tests - accessing') -----
testNext
|stream|
stream := self streamOnArray.
self assert: stream next = 1.
self assert: stream next = #(a b c).
self assert: stream next = false.
stream := self streamOnString.
self assert: stream next = $a.
self assert: stream next = $b.
self assert: stream next = $c.
self assert: stream next = $d.
self assert: stream next = $e.
!
----- Method: TGettableStreamTest>>testNextMatchFor (in category 'tests - testing') -----
testNextMatchFor
| stream |
stream := self streamOnArray.
self assert: (stream nextMatchFor: 1).
self assert: (stream nextMatchFor: #(a b c)).
self assert: (stream nextMatchFor: false).
stream := self streamOnArray.
self deny: (stream nextMatchFor: false).
self assert: (stream nextMatchFor: #(a b c)).
self assert: (stream nextMatchFor: false).
!
----- Method: TGettableStreamTest>>testNexts (in category 'tests - accessing') -----
testNexts
self assert: (self emptyStream next: 0) isEmpty.
self assert: (self streamOnArray next: 0) isEmpty.
self assert: (self streamOnArray next: 1) = #(1).
self assert: (self streamOnArray next: 2) = #(1 #(a b c)).
self assert: (self streamOnArray next: 3) = #(1 #(a b c) false).!
----- Method: TGettableStreamTest>>testNexts2 (in category 'tests - accessing') -----
testNexts2
| stream |
stream := self streamOnArray.
self assert: (stream next: 2) = #(1 #(a b c)).
self assert: (stream next: 1) = #(false).!
----- Method: TGettableStreamTest>>testOldBack (in category 'tests - back') -----
testOldBack
"Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)"
|stream|
stream := self streamOn: 'abc'.
stream next: 2.
self assert: stream oldBack = $a.!
----- Method: TGettableStreamTest>>testOldBackOnPosition1 (in category 'tests - back') -----
testOldBackOnPosition1
"Test the old behavior of the method back. The method #oldBack is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. The method #oldBack considers that the pointer is *on* an element. (Damien Cassou - 1 August 2007)"
|stream|
stream := self streamOn: 'abc'.
stream next.
self assert: stream oldBack = nil.!
----- Method: TGettableStreamTest>>testPeek (in category 'tests - accessing') -----
testPeek
| stream |
stream := self streamOnArray.
self assert: stream peek = 1.
self deny: stream peek = #(a b c).
self deny: stream peek = false.
stream next.
self deny: stream peek = 1.
self assert: stream peek = #(a b c).
self deny: stream peek = false.
stream next.
self deny: stream peek = 1.
self deny: stream peek = #(a b c).
self assert: stream peek = false.
stream next.
"In ANSI Smalltalk Standard Draft, it is said that nil will return nil at the end when using #peek."
self assert: stream peek isNil.!
----- Method: TGettableStreamTest>>testPeek2 (in category 'tests - accessing') -----
testPeek2
| stream |
stream := self streamOn: #(nil nil nil).
self assert: stream peek isNil.
stream next.
self assert: stream peek isNil.
stream next.
self assert: stream peek isNil.
stream next.
"Yes, #peek answers nil when there is no more element to read."
self assert: stream peek isNil.!
----- Method: TGettableStreamTest>>testPeekFor (in category 'tests - testing') -----
testPeekFor
| stream |
stream := self streamOnArray.
self assert: (stream peekFor: 1).
self assert: (stream peekFor: #(a b c)).
self assert: (stream peekFor: false).
stream := self streamOnArray.
self deny: (stream peekFor: #(a b c)).
self deny: (stream peekFor: false).
self assert: (stream peekFor: 1).
self deny: (stream peekFor: 1).
self deny: (stream peekFor: false).
self assert: (stream peekFor: #(a b c)).
self deny: (stream peekFor: 1).
self deny: (stream peekFor: #(a b c)).
self assert: (stream peekFor: false).
self assert: (stream atEnd).
self deny: (stream peekFor: nil).
self deny: (stream peekFor: 1).
self deny: (stream peekFor: #(a b c)).
self deny: (stream peekFor: false).!
----- Method: TGettableStreamTest>>testPeekFor2 (in category 'tests - testing') -----
testPeekFor2
| stream negative number |
stream := self streamOn: '- 145'.
negative := stream peekFor: $-.
stream peekFor: Character space.
number := stream next: 3.
self assert: negative.
self assert: number = '145'.
stream := self streamOn: '-145'.
negative := stream peekFor: $-.
stream peekFor: Character space.
number := stream next: 3.
self assert: negative.
self assert: number = '145'.
stream := self streamOn: ' 145'.
negative := stream peekFor: $-.
stream peekFor: Character space.
number := stream next: 3.
self deny: negative.
self assert: number = '145'.
stream := self streamOn: '145'.
negative := stream peekFor: $-.
stream peekFor: Character space.
number := stream next: 3.
self deny: negative.
self assert: number = '145'.!
----- Method: TGettableStreamTest>>testSkipTo (in category 'tests - positionning') -----
testSkipTo
| stream |
stream := self emptyStream.
self deny: (stream skipTo: nil).
stream := self streamOnArray.
self deny: stream atEnd.
self deny: (stream skipTo: nil).
self assert: stream atEnd.
stream := self streamOnArray.
self assert: stream peek = 1.
self assert: (stream skipTo: #(a b c)).
self assert: stream peek = false.
self assert: (stream skipTo: false).
self assert: stream atEnd.!
----- Method: TGettableStreamTest>>testSkipTo2 (in category 'tests - positionning') -----
testSkipTo2
| stream |
stream := self streamOnString.
self assert: (stream skipTo: $b).
self assert: stream peek = $c.
self assert: (stream skipTo: $d).
self assert: stream peek = $e.
self assert: (stream skipTo: $e).
self assert: stream atEnd.!
----- Method: TGettableStreamTest>>testUpTo (in category 'tests - accessing') -----
testUpTo
| returnValue stream |
returnValue := (self emptyStream upTo: nil).
self assert: returnValue isCollection.
self assert: returnValue isEmpty.
stream := self streamOnArray.
returnValue := stream upTo: #(a b c).
self assert: returnValue = #(1).
self assert: stream peek = false.
stream := self streamOnArray.
returnValue := stream upTo: true.
self assert: returnValue = #(1 #(a b c) false).
self assert: stream atEnd.!
----- Method: TGettableStreamTest>>testUpTo2 (in category 'tests - accessing') -----
testUpTo2
| returnValue stream |
stream := self streamOnString.
returnValue := stream upTo: $d.
self assert: returnValue = 'abc'.
self assert: stream peek = $e.!
----- Method: TPuttableStreamTest>>testNextPutAllAppending (in category 'tests - accessing') -----
testNextPutAllAppending
| stream |
stream := self emptyStream.
self shouldnt: [
stream
nextPutAll: 'abc'.
] raise: Error.!
----- Method: TPuttableStreamTest>>testNextPutAllReplacing (in category 'tests - accessing') -----
testNextPutAllReplacing
| stream |
stream := self streamOnString.
stream reset.
self shouldnt: [
stream
nextPutAll: 'abc'.
] raise: Error.!
----- Method: TPuttableStreamTest>>testNextPutAppending (in category 'tests - accessing') -----
testNextPutAppending
| stream |
stream := self emptyStream.
self shouldnt: [
stream
nextPut: $a;
nextPut: $b;
nextPut: $c.
] raise: Error.!
----- Method: TPuttableStreamTest>>testNextPutReplacing (in category 'tests - accessing') -----
testNextPutReplacing
| stream |
stream := self streamOnArray.
stream reset.
self shouldnt: [
stream
nextPut: $a;
nextPut: $b;
nextPut: $c.
] raise: Error.!
HashAndEqualsTestCase subclass: #TextAlignmentTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
----- Method: TextAlignmentTest>>setUp (in category 'initialize-release') -----
setUp
super setUp.
prototypes add: TextAlignment centered;
add: TextAlignment justified;
add: TextAlignment leftFlush;
add: TextAlignment rightFlush !
HashAndEqualsTestCase subclass: #TextEmphasisTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
----- 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 !
----- Method: TextEmphasisTest>>testAppendString (in category 'tests') -----
testAppendString
"tests the Text>>prepend: method when appending a String "
"self run: # testAppendString"
| receiver argument result expectedResult |
receiver := 'xxx' asText
addAttribute: TextEmphasis bold from: 1 to: 3.
argument := 'yyy'.
expectedResult := 'xxxyyy' asText
addAttribute: TextEmphasis bold from: 1 to: 3.
result := receiver append: argument.
self assert: (result == receiver).
self assert: (result string = expectedResult string).
self assert: (result runs = expectedResult runs)!
----- Method: TextEmphasisTest>>testAppendText (in category 'tests') -----
testAppendText
"tests the Text>>prepend: method when appending a Text "
| receiver argument result expectedResult |
receiver := 'xxx' asText
addAttribute: TextEmphasis bold from: 1 to: 3.
argument := 'yyy' asText
addAttribute: TextEmphasis italic from: 1 to: 3. .
expectedResult := 'xxxyyy' asText
addAttribute: TextEmphasis bold from: 1 to: 3;
addAttribute: TextEmphasis italic from: 4 to: 6.
result := receiver append: argument.
self assert: (result == receiver).
self assert: (result string = expectedResult string).
self assert: (result runs = expectedResult runs)
!
----- Method: TextEmphasisTest>>testPrependString (in category 'tests') -----
testPrependString
"tests the Text>>prepend: method when prepending a String "
| receiver argument result expectedResult |
receiver := 'xxx' asText
addAttribute: TextEmphasis bold from: 1 to: 3.
argument := 'yyy'.
expectedResult := 'yyyxxx' asText
addAttribute: TextEmphasis bold from: 4 to: 6.
result := receiver prepend: argument.
self assert: (result == receiver).
self assert: (result string = expectedResult string).
self assert: (result runs = expectedResult runs)
!
----- Method: TextEmphasisTest>>testPrependText (in category 'tests') -----
testPrependText
"tests the Text>>prepend: method when prepending Text "
| receiver argument result expectedResult |
receiver := 'xxx' asText
addAttribute: TextEmphasis bold from: 1 to: 3.
argument := 'yyy' asText
addAttribute: TextEmphasis italic from: 1 to: 3.
expectedResult := 'yyyxxx' asText
addAttribute: TextEmphasis italic from: 1 to: 3;
addAttribute: TextEmphasis bold from: 4 to: 6.
result := receiver prepend: argument.
self assert: (result == receiver).
self assert: (result string = expectedResult string).
self assert: (result runs = expectedResult runs)!
HashAndEqualsTestCase subclass: #TextFontChangeTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
----- 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) !
----- Method: TextFontChangeTest>>testEquality (in category 'tests') -----
testEquality
"Check that different instances of the same TextFontChange are equal"
self assert: TextFontChange defaultFontChange = TextFontChange defaultFontChange.
self assert: TextFontChange font1 = TextFontChange font1.
self assert: TextFontChange font2 = TextFontChange font2.
self assert: TextFontChange font3 = TextFontChange font3.
self assert: TextFontChange font4 = TextFontChange font4.
self assert: (TextFontChange fontNumber: 6)
= (TextFontChange fontNumber: 6)!
----- Method: TextFontChangeTest>>testHash (in category 'tests') -----
testHash
"test that different instances of the same TextFontChange hash to the
same value"
| hashes hash |
hashes := OrderedCollection new.
1
to: 100
do: [:i | hashes add: TextFontChange defaultFontChange hash].
hash := hashes at: 1.
2
to: 100
do: [:i | self assert: (hashes at: i)
= hash]!
HashAndEqualsTestCase subclass: #TextFontReferenceTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
----- Method: TextFontReferenceTest>>setUp (in category 'tests') -----
setUp
super setUp.
prototypes
add: (TextFontReference
toFont: (StrikeFont familyName: 'NewYork' size: 15)) !
HashAndEqualsTestCase subclass: #TextKernTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
----- Method: TextKernTest>>setUp (in category 'tests') -----
setUp
super setUp.
prototypes
add: (TextKern kern: 1) !
----- Method: TStreamTest>>classUnderTest (in category 'accessing') -----
classUnderTest
self explicitRequirement!
----- Method: TStreamTest>>emptyStream (in category 'accessing - defaults') -----
emptyStream
^ self streamOn: String new!
----- Method: TStreamTest>>streamOn: (in category 'helpers') -----
streamOn: aCollection
^ self classUnderTest on: aCollection!
----- Method: TStreamTest>>streamOnArray (in category 'accessing - defaults') -----
streamOnArray
^ self streamOn: (Array with: 1 with: #(a b c) with: false)!
----- Method: TStreamTest>>streamOnString (in category 'accessing - defaults') -----
streamOnString
^ self streamOn: 'abcde'!
----- Method: TSequencedStreamTest>>testBackUpTo1 (in category 'tests - positioning') -----
testBackUpTo1
|stream|
stream := ReadStream on: 'abcdabg'.
stream setToEnd.
self assert: (stream backUpTo: 'ab').
self assert: stream peek = $g!
----- Method: TSequencedStreamTest>>testBackUpToEmptyPattern1 (in category 'tests - positioning') -----
testBackUpToEmptyPattern1
"This test represents the current behavior which is not clearly defined and could be revised."
|stream|
stream := ReadStream on: 'abcdabg'.
stream setToEnd.
self should: [stream backUpTo: ''] raise: Error.!
----- Method: TSequencedStreamTest>>testBackUpToPatternNotFound1 (in category 'tests - positioning') -----
testBackUpToPatternNotFound1
|stream|
stream := ReadStream on: 'abcdabg'.
stream setToEnd.
self deny: (stream backUpTo: 'zz').
self assert: stream position = 0!
----- Method: TSequencedStreamTest>>testContents (in category 'tests - accessing') -----
testContents
| stream |
self assert: self emptyStream contents = ''.
stream := self streamOnArray.
self assert: stream contents = #(1 #(a b c) false).
stream position: 3.
self assert: stream contents = #(1 #(a b c) false).
stream := self streamOnString.
self assert: stream contents = 'abcde'.
stream setToEnd.
self assert: stream contents = 'abcde'.!
----- Method: TSequencedStreamTest>>testReset (in category 'tests - positioning') -----
testReset
| stream |
stream := self emptyStream.
stream reset.
self assert: stream position = 0.
stream := self streamOnArray.
stream reset.
self assert: stream position = 0.
self deny: stream atEnd.
stream position: 3.
self assert: stream atEnd.
stream reset.
self assert: stream position = 0.!
----- Method: TSequencedStreamTest>>testSetPosition (in category 'tests - positioning') -----
testSetPosition
| stream |
stream := self emptyStream.
self should: [stream position: -2] raise: Error.
self shouldnt: [stream position: 0] raise: Error.
stream := self streamOnArray.
self should: [stream position: -1] raise: Error.
self shouldnt: [stream position: 0] raise: Error.
self shouldnt: [stream position: 1] raise: Error.
self shouldnt: [stream position: 2] raise: Error.
"According to ANSI Smalltalk Standard 1.9 Draft, the following should be tested too:
self should: [stream position: 3] raise: Error.
However, I don't see the point of raising an error when positioning at the end.
I prefer testing the absence of error:
"
self shouldnt: [stream position: 3] raise: Error.
self should: [stream position: 4] raise: Error.!
----- Method: TSequencedStreamTest>>testSetToEnd (in category 'tests - positioning') -----
testSetToEnd
| stream |
stream := self emptyStream.
stream setToEnd.
self assert: stream atEnd.
stream := self streamOnArray.
stream setToEnd.
self assert: stream atEnd.
stream position: 1.
self deny: stream atEnd.
stream setToEnd.
self assert: stream atEnd.!
ClassTestCase subclass: #ArrayTest
instanceVariableNames: 'example1 literalArray selfEvaluatingArray otherArray nonSEArray1 nonSEarray2 example2'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Arrayed'!
!ArrayTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Array. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: ArrayTest>>setUp (in category 'initialize-release') -----
setUp
literalArray := #(1 true 3 #four).
selfEvaluatingArray := { 1. true. (3/4). Color black. (2 to: 4) . 5 }.
nonSEArray1 := { 1 . Set with: 1 }.
nonSEarray2 := { Smalltalk associationAt: #Array }.
example1 := #(1 2 3 4 5).
example2 := {1. 2. 3/4. 4. 5}. !
----- Method: ArrayTest>>testAtWrap (in category 'tests - accessing') -----
testAtWrap
|tabTest|
tabTest := #(5 6 8).
self assert:(tabTest atWrap: 2) = 6.
self assert:(tabTest atWrap:7) = 5.
self assert:( tabTest atWrap:5) = 6.
self assert:(tabTest atWrap:0)= 8.
self assert:(tabTest atWrap:1)= 5.
self assert:(tabTest atWrap:-2) = 5.
!
----- Method: ArrayTest>>testIsArray (in category 'testing') -----
testIsArray
self assert: example1 isArray!
----- Method: ArrayTest>>testIsLiteral (in category 'testing') -----
testIsLiteral
"We work with a copy of literalArray, to avoid corrupting the code."
| l |
l := literalArray copy.
self assert: l isLiteral.
l at: 1 put: self class.
self deny: l isLiteral!
----- Method: ArrayTest>>testIsSelfEvaluating (in category 'testing') -----
testIsSelfEvaluating
self assert: example1 isSelfEvaluating.
example1 at: 1 put: Bag new.
self deny: example1 isSelfEvaluating.
example1 at: 1 put: 1.!
----- Method: ArrayTest>>testLiteralEqual (in category 'testing') -----
testLiteralEqual
self
deny: (example1 literalEqual: example1 asIntegerArray)!
----- 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]!
----- Method: ArrayTest>>testPremultiply (in category 'testing') -----
testPremultiply
self assert: example1 +* #(2 ) = #(2 4 6 8 10 ) !
----- Method: ArrayTest>>testPrinting (in category 'testing') -----
testPrinting
self assert: literalArray printString = '#(1 true 3 #four)'.
self assert: (literalArray = (Compiler evaluate: literalArray printString)).
self assert: selfEvaluatingArray printString = '{1 . true . (3/4) . Color black . (2 to: 4) . 5}'.
self assert: (selfEvaluatingArray = (Compiler evaluate: selfEvaluatingArray printString)).
self assert: nonSEArray1 printString = 'an Array(1 a Set(1))'.
self assert: nonSEarray2 printString = 'an Array(#Array)'
!
ClassTestCase subclass: #AssociationTest
instanceVariableNames: 'a b'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Support'!
----- Method: AssociationTest>>setUp (in category 'setup') -----
setUp
a := 1 -> 'one'.
b := 1 -> 'een'.!
----- Method: AssociationTest>>testEquality (in category 'tests') -----
testEquality
self
assert: (a key = b key);
deny: (a value = b value);
deny: (a = b)
!
----- Method: AssociationTest>>testHash (in category 'tests') -----
testHash
self
assert: (a hash = a copy hash);
deny: (a hash = b hash)!
----- Method: AssociationTest>>testIsSelfEvaluating (in category 'tests') -----
testIsSelfEvaluating
self
assert: (a isSelfEvaluating)
!
ClassTestCase subclass: #CharacterSetComplementTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Support'!
!CharacterSetComplementTest commentStamp: '<historical>' prior: 0!
CharacterSetComplementTest hold unit tests for CharacterSetComplement!
----- Method: CharacterSetComplementTest>>testPrintString (in category 'testing') -----
testPrintString
"This is about CharacterSetComplementTest"
self shouldnt: [CharacterSet separators complement printString] raise: Error!
ClassTestCase subclass: #CharacterTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!CharacterTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Character. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: CharacterTest>>testCodePoint (in category 'tests - creation') -----
testCodePoint
self assert: (Character codePoint: $A asciiValue) = $A.
self shouldnt:[Character codePoint: 500] raise: Error.
self assert: (Character codePoint: 500) asciiValue = 500.!
----- Method: CharacterTest>>testNew (in category 'testing - Class Methods') -----
testNew
self should: [Character new] raise: Error.!
----- Method: CharacterTest>>testPrintString (in category 'testing-printing') -----
testPrintString
self assert: $a printString = '$a'.
self assert: $5 printString = '$5'.
self assert: $@ printString = '$@'.
self assert: Character cr printString = 'Character cr'.
self assert: Character lf printString = 'Character lf'.
self assert: Character space printString = 'Character space'.
self assert: (Character value: 0) printString = 'Character value: 0'.
self assert: (Character value: 17) printString = 'Character value: 17'.!
----- Method: CharacterTest>>testPrintStringAll (in category 'testing-printing') -----
testPrintStringAll
Character allCharacters do: [ :each |
self assert: (self class compilerClass
evaluate: each printString) = each ].!
----- Method: CharacterTest>>testStoreString (in category 'testing-printing') -----
testStoreString
self assert: $a storeString = '$a'.
self assert: $5 storeString = '$5'.
self assert: $@ storeString = '$@'.
self assert: Character cr storeString = 'Character cr'.
self assert: Character lf storeString = 'Character lf'.
self assert: Character space storeString = 'Character space'.
self assert: (Character value: 0) storeString = '(Character value: 0)'.
self assert: (Character value: 17) storeString = '(Character value: 17)'.!
----- Method: CharacterTest>>testStoreStringAll (in category 'testing-printing') -----
testStoreStringAll
Character allCharacters do: [ :each |
self assert: (self class compilerClass
evaluate: each storeString) = each ].!
ClassTestCase subclass: #FloatArrayTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Arrayed'!
!FloatArrayTest commentStamp: 'nice 5/30/2006 01:24' prior: 0!
These tests are used to assert that FloatArrayPlugin has same results as Float asIEEE32BitWord!
----- 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)].!
----- 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 infinity negated 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].!
----- 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 infinity negated with: Float negativeZero with: Float nan)
do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord].
!
ClassTestCase subclass: #HeapTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
----- Method: HeapTest>>heapExample (in category 'examples') -----
heapExample "HeapTest new heapExample"
"Create a sorted collection of numbers, remove the elements
sequentially and add new objects randomly.
Note: This is the kind of benchmark a heap is designed for."
| n rnd array time sorted |
n := 5000. "# of elements to sort"
rnd := Random new.
array := (1 to: n) collect:[:i| rnd next].
"First, the heap version"
time := Time millisecondsToRun:[
sorted := Heap withAll: array.
1 to: n do:[:i|
sorted removeFirst.
sorted add: rnd next].
].
Transcript cr; show:'Time for Heap: ', time printString,' msecs'.
"The quicksort version"
time := Time millisecondsToRun:[
sorted := SortedCollection withAll: array.
1 to: n do:[:i|
sorted removeFirst.
sorted add: rnd next].
].
Transcript cr; show:'Time for SortedCollection: ', time printString,' msecs'.
!
----- Method: HeapTest>>heapSortExample (in category 'examples') -----
heapSortExample "HeapTest new heapSortExample"
"Sort a random collection of Floats and compare the results with
SortedCollection (using the quick-sort algorithm) and
ArrayedCollection>>mergeSortFrom:to:by: (using the merge-sort algorithm)."
| n rnd array time sorted |
n := 10000. "# of elements to sort"
rnd := Random new.
array := (1 to: n) collect:[:i| rnd next].
"First, the heap version"
time := Time millisecondsToRun:[
sorted := Heap withAll: array.
1 to: n do:[:i| sorted removeFirst].
].
Transcript cr; show:'Time for heap-sort: ', time printString,' msecs'.
"The quicksort version"
time := Time millisecondsToRun:[
sorted := SortedCollection withAll: array.
].
Transcript cr; show:'Time for quick-sort: ', time printString,' msecs'.
"The merge-sort version"
time := Time millisecondsToRun:[
array mergeSortFrom: 1 to: array size by: [:v1 :v2| v1 <= v2].
].
Transcript cr; show:'Time for merge-sort: ', time printString,' msecs'.
!
----- Method: HeapTest>>test1 (in category 'testing') -----
test1
| data h |
"The first element of each array is the sort value, and the second will be updated by the heap with the index of the element within the heap."
data := (1 to: 8) collect: [:i | {i*2. 0}].
"Repeat with different data ordering."
5 timesRepeat: [
h := Heap new sortBlock: [:e1 :e2 | e1 first < e2 first].
h indexUpdateBlock: [:array :index | array at: 2 put: index].
data shuffled do: [:d | h add: d].
data do: [:d | self should: (h at: d second) == d].
]!
----- Method: HeapTest>>testAdd (in category 'basic tests') -----
testAdd
"self run: #testAdd"
| heap |
heap := Heap new.
self assert: heap size = 0.
heap add: 3.
self assert: heap size = 1.
self assert: heap isEmpty not.
self assert: heap first = 3.
self assert: (heap at: 1) = 3.
heap add: 2.
self assert: heap size = 2.
self assert: heap first = 2.
self assert: (heap at: 2) = 3.
!
----- Method: HeapTest>>testAt (in category 'basic tests') -----
testAt
"self run: #testAt"
| heap |
heap := Heap new.
heap add: 3.
self assert: (heap at: 1) = 3.
self should: [heap at: 2] raise: Error.
heap add: 4.
self assert: (heap at: 1) = 3.
self assert: (heap at: 2) = 4.
!
----- Method: HeapTest>>testDo (in category 'basic tests') -----
testDo
"self run: #testDo"
| heap coll |
heap := Heap withAll: #(1 3 5).
coll := OrderedCollection new.
heap do: [:each | coll add: each].
self assert: coll = #(1 3 5) asOrderedCollection.
!
----- Method: HeapTest>>testExamples (in category 'testing') -----
testExamples
self shouldnt: [self heapExample] raise: Error.
self shouldnt: [self heapSortExample] raise: Error.!
----- Method: HeapTest>>testFirst (in category 'basic tests') -----
testFirst
"self run: #testFirst"
| heap |
heap := Heap new.
heap add: 5.
heap add: 12.
heap add: 1.
self assert: heap first = 1.
heap removeFirst.
self assert: heap first = 5.!
----- Method: HeapTest>>testHeap (in category 'basic tests') -----
testHeap
"self run: #testHeap"
| heap |
heap := Heap new.
self assert: heap isHeap.
self assert: heap isEmpty.
heap add: 1.
self assert: heap isEmpty not
!
----- Method: HeapTest>>testRemove (in category 'basic tests') -----
testRemove
"self run: #testRemove"
| heap |
heap := Heap new.
self should: [heap removeFirst] raise: Error.
heap add: 5.
self shouldnt: [heap removeFirst] raise: Error.
self assert: heap size = 0.
heap add: 5.
self should: [heap removeAt: 2] raise: Error.!
----- Method: HeapTest>>testSortBlock (in category 'basic tests') -----
testSortBlock
"self run: #testSortBlock"
| heap |
heap := Heap withAll: #(1 3 5).
self assert: heap = #(1 3 5).
heap sortBlock: [ :e1 :e2 | e1 >= e2 ].
self assert: heap = #(5 3 1)
!
ClassTestCase subclass: #IntegerArrayTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Arrayed'!
!IntegerArrayTest commentStamp: 'dtl 10/3/2009 16:37' prior: 0!
Verify storage of integer values in an IntegerArray. An IntegerArray stores 32-bit signed integer values. Lack of range check in primitive fallback code leads to arithmetic overflow errors, so attempts to store out of range values should raise errors.!
----- Method: IntegerArrayTest>>testStoreLargeNegativeInteger (in category 'tests') -----
testStoreLargeNegativeInteger
"A LargeNegativeInteger that does not exceed the range of a 32-bit twos
complement integer may be stored."
| ia val |
ia := IntegerArray new: 1.
val := (2 raisedTo: 31) negated. "smallest negative 32-bit integer, a LargeNegativeInteger"
ia at: 1 put: val.
self assert: ((ia at: 1) = val)
!
----- Method: IntegerArrayTest>>testStoreLargePositiveInteger (in category 'tests') -----
testStoreLargePositiveInteger
"A LargePositiveInteger that does not exceed the range of a 32-bit twos
complement integer may be stored."
| ia val |
ia := IntegerArray new: 1.
val := (2 raisedTo: 31) - 1. "largest positive 32-bit integer, a LargePositiveInteger"
ia at: 1 put: val.
self assert: ((ia at: 1) = val)
!
----- Method: IntegerArrayTest>>testStoreNegativeOutOfRange (in category 'tests') -----
testStoreNegativeOutOfRange
"A value too small for a 32-bit signed integer should raise an error."
| ia val storedValue |
ia := IntegerArray new: 1.
val := (2 raisedTo: 31) negated - 1. " -16r80000001 of range for 32-bit twos complement integer"
self should: [ia at: 1 put: val. "should raise error here"
storedValue := ia at: 1. "lack of range check leads to value of 16r7FFFFFFF"
self assert: val = storedValue "fail here"]
raise: Error
!
----- Method: IntegerArrayTest>>testStorePositiveOutOfRange (in category 'tests') -----
testStorePositiveOutOfRange
"A value too large for a 32-bit signed integer should raise an error."
| ia val storedValue |
ia := IntegerArray new: 1.
val := 2 raisedTo: 31. "16r80000000 is out of range for 32-bit twos complement"
self should: [ia at: 1 put: val. "should raise error here"
storedValue := ia at: 1. "lack of range check leads to value of 16r-80000000"
self assert: val = storedValue "fail here"]
raise: Error
!
----- Method: IntegerArrayTest>>testStoreSmallInteger (in category 'tests') -----
testStoreSmallInteger
"Any SmallInteger may be stored in an IntegerArray."
| ia val |
ia := IntegerArray new: 1.
val := SmallInteger maxVal.
ia at: 1 put: val.
self assert: ((ia at: 1) = val).
val := SmallInteger minVal.
ia at: 1 put: val.
self assert: ((ia at: 1) = val)
!
ClassTestCase subclass: #IntervalTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
----- Method: IntervalTest>>testAdd (in category 'tests') -----
testAdd
self assert: (1 to: 10)
+ 5
= (6 to: 15)!
----- Method: IntervalTest>>testAsInterval (in category 'tests') -----
testAsInterval
"This is the same as newFrom:"
self shouldnt: [
self assert: (#(1 2 3) as: Interval) = (1 to: 3).
self assert: (#(33 5 -23) as: Interval) = (33 to: -23 by: -28).
self assert: (#(2 4 6) asByteArray as: Interval) = (2 to: 6 by: 2).
] raise: Error.
self should: [#(33 5 -22) as: Interval]
raise: Error
description: 'This is not an arithmetic progression'
!
----- Method: IntervalTest>>testAt (in category 'tests') -----
testAt
self assert: ((1 to: 10)
at: 1)
= 1.
self assert: ((1 to: 10)
at: 3)
= 3.
self assert: ((1 to: 10 by: 2)
at: 1)
= 1.
self assert: ((1 to: 10 by: 2)
at: 3)
= 5!
----- Method: IntervalTest>>testDo (in category 'tests') -----
testDo
| s i |
s := OrderedCollection new.
i := (10 to: 20).
i do: [ :each | s addLast: each].
self assert: (s hasEqualElements: i)!
----- Method: IntervalTest>>testEquals (in category 'tests') -----
testEquals
self shouldnt: [
self assert: (3 to: 5) = #(3 4 5).
self deny: (3 to: 5) = #(3 5).
self deny: (3 to: 5) = #().
self assert: #(3 4 5) = (3 to: 5).
self deny: #(3 5) = (3 to: 5).
self deny: #() = (3 to: 5).
] raise: MessageNotUnderstood.!
----- Method: IntervalTest>>testEquals2 (in category 'tests') -----
testEquals2
self assert: (3 to: 5) = #(3 4 5).
self deny: (3 to: 5) = #(3 5).
self deny: (3 to: 5) = #().
self assert: #(3 4 5) = (3 to: 5).
self deny: #(3 5) = (3 to: 5).
self deny: #() = (3 to: 5).!
----- Method: IntervalTest>>testEquals3 (in category 'tests') -----
testEquals3
self assert: (3 to: 5 by: 2) first = (3 to: 6 by: 2) first.
self assert: (3 to: 5 by: 2) last = (3 to: 6 by: 2) last.
self assert: (3 to: 5 by: 2) = (3 to: 6 by: 2).!
----- Method: IntervalTest>>testEquals4 (in category 'tests') -----
testEquals4
self assert: (3 to: 5 by: 2) = #(3 5).
self deny: (3 to: 5 by: 2) = #(3 4 5).
self deny: (3 to: 5 by: 2) = #().
self assert: #(3 5) = (3 to: 5 by: 2).
self deny: #(3 4 5) = (3 to: 5 by: 2).
self deny: #() = (3 to: 5 by: 2).!
----- Method: IntervalTest>>testEquals5 (in category 'tests') -----
testEquals5
self assert: (3 to: 5 by: 2) = (Heap withAll: #(3 5)).
self deny: (3 to: 5 by: 2) = (Heap withAll: #(3 4 5)).
self deny: (3 to: 5 by: 2) = Heap new.
self assert: (Heap withAll: #(3 5)) = (3 to: 5 by: 2).
self deny: (Heap withAll: #(3 4 5)) = (3 to: 5 by: 2).
self deny: Heap new = (3 to: 5 by: 2).!
----- Method: IntervalTest>>testEquals6 (in category 'tests') -----
testEquals6
self assert: #() = Heap new.
self assert: #(3 5) = (Heap withAll: #(3 5)).
self deny: (3 to: 5 by: 2) = (Heap withAll: #(3 4 5)).
self deny: (3 to: 5 by: 2) = Heap new.
self assert: Heap new = #().
self assert: (Heap withAll: #(3 5)) = #(3 5).
self deny: (Heap withAll: #(3 4 5)) = #(3 5).
self deny: Heap new = #(3 5).!
----- Method: IntervalTest>>testExtent (in category 'tests') -----
testExtent
self assert: (1 to: 10) extent = 9.
self assert: (1 to: 10 by: 2) extent = 9.
self assert: (1 to:-1) extent = -2!
----- Method: IntervalTest>>testInclusionBug1603 (in category 'tests') -----
testInclusionBug1603
"This test is by german morales.
It is about mantis bug 1603"
self shouldnt: ((1 to: 5 by: 1) includes: 2.5). "obvious"
self shouldnt: ((100000000000000 to: 500000000000000 by: 100000000000000)
includes: 250000000000000). "same as above with 14 zeros appended"!
----- Method: IntervalTest>>testInclusionBug6455 (in category 'tests') -----
testInclusionBug6455
"This test is about mantis bug http://bugs.squeak.org/view.php?id=6455
It should work as long as Fuzzy inclusion test feature for Interval of Float is maintained.
This is a case when tested element is near ones of actual value, but by default.
Code used to work only in the case of close numbers by excess..."
self assert: ((0 to: Float pi by: Float pi / 100) includes: Float pi * (3/100))!
----- Method: IntervalTest>>testIndexOfBug1602 (in category 'tests') -----
testIndexOfBug1602
"This test is by german morales.
It is about mantis bug 1602"
self should: ((1 to: 5 by: 1) indexOf: 2.5) = 0. "obvious"
self should: ((100000000000000 to: 500000000000000 by: 100000000000000)
indexOf: 250000000000000) = 0. "same as above with 14 zeros appended"!
----- Method: IntervalTest>>testIndexOfBug6455 (in category 'tests') -----
testIndexOfBug6455
"This test is about mantis bug http://bugs.squeak.org/view.php?id=6455
It should work as long as Fuzzy inclusion test feature for Interval of Float is maintained.
This is a case when tested element is near ones of actual value, but by default.
Code used to work only in the case of close numbers by excess..."
self assert: ((0 to: Float pi by: Float pi / 100) indexOf: Float pi * (3/100)) = 4!
----- Method: IntervalTest>>testIntervalStoreOn (in category 'tests') -----
testIntervalStoreOn
"this is a test for http://bugs.squeak.org/view.php?id=4378"
| interval1 interval2 |
interval1 := 0 to: 1 by: 0.5s1 squared.
interval2 := Compiler evaluate: interval1 storeString.
self assert: interval1 size = interval2 size!
----- Method: IntervalTest>>testInvalid (in category 'tests') -----
testInvalid
"empty, impossible ranges"
self assert: (1 to: 0) = #().
self assert: (1 to: -1) = #().
self assert: (-1 to: -2) = #().
self assert: (1 to: 5 by: -1) = #().
"always contains only start value."
self assert: (1 to: 1) = #(1).
self assert: (1 to: 5 by: 10) = #(1).
self assert: (1 to: 0 by: -2) = #(1).
!
----- Method: IntervalTest>>testIsEvaluating (in category 'tests') -----
testIsEvaluating
self assert: (1 to: 10) isSelfEvaluating.
self assert: (1 to: 10 by: 2) isSelfEvaluating!
----- Method: IntervalTest>>testIsInterval (in category 'tests') -----
testIsInterval
self assert: (1 to: 10) isInterval.
self assert: (1 to: 10 by: 2) isInterval!
----- Method: IntervalTest>>testLast (in category 'tests') -----
testLast
self assert: (1 to:10) last = 10.
self assert: (1 to:10 by:2) last = 9 !
----- Method: IntervalTest>>testMinus (in category 'tests') -----
testMinus
self assert: (1 to: 10)
- 5
= (-4 to: 5)!
----- Method: IntervalTest>>testNewFrom (in category 'tests') -----
testNewFrom
self shouldnt: [
self assert: ( (Interval newFrom: (1 to: 1)) = (1 to: 1)).
self assert: ( (Interval newFrom: #(1)) = (1 to: 1)).
self assert: ( (Interval newFrom: #()) = ( 1 to: 0)) .
] raise: Error.!
----- Method: IntervalTest>>testNumericTypes (in category 'tests') -----
testNumericTypes
(3 asNumber) to: 5 = #(3 4 5).
3.0 to: 5.0 = #(3.0 4.0 5.0).
3.0 to: 5.0 by: 0.5 = #(3.0 3.5 4.0 4.5 5.0).
3/1 to: 5/1 = #(3 4 5).
1/2 to: 5/2 by: 1/2 = #(1/2 1 3/2 2 5/2).!
----- Method: IntervalTest>>testOtherNewFrom (in category 'tests') -----
testOtherNewFrom
self assert: (Interval newFrom: #(1 2 3 )) = (1 to: 3).
self assert: (Interval newFrom: #(33 5 -23 )) = (33 to: -23 by: -28).
self should: [(Interval newFrom: #(33 5 -22 ))] raise: Error.
self assert: (#(33 5 -23) as: Interval) = (33 to: -23 by: -28).
self should: [( #(33 5 -22 ) as: Interval)] raise: Error.
self assert: ( (-4 to: -12 by: -1) as: Interval) = (-4 to: -12 by: -1).
self assert: ( Interval newFrom: (1 to: 1)) = (1 to: 1).
self assert: ( Interval newFrom: (1 to: 0)) = (1 to: 0).
self assert: (#(1) as: Interval) = (1 to: 1).
self assert: (#() as: Interval) = (1 to: 0).!
----- Method: IntervalTest>>testPermutationsDo (in category 'tests') -----
testPermutationsDo
| i oc |
i := (1.234 to: 4.234).
oc := OrderedCollection new.
i permutationsDo: [:e | oc add: e].
self assert: (oc size == i size factorial).
^ oc!
----- Method: IntervalTest>>testRangeIncludes (in category 'tests') -----
testRangeIncludes
self
assert: ((1 to: 10)
rangeIncludes: 3).
self
assert: ((1 to: 10 by: 2)
rangeIncludes: 3).
self
deny: ((1 to: 10)
rangeIncludes: 0).
self
deny: ((1 to: 10)
rangeIncludes: 11).
self
deny: ((1 to: 10 by: 2)
rangeIncludes: 0).
self
deny: ((1 to: 10 by: 2)
rangeIncludes: 11)!
----- Method: IntervalTest>>testReverseDo (in category 'tests') -----
testReverseDo
| s i |
s := OrderedCollection new.
i := 10 to: 20.
i
reverseDo: [:each | s addFirst: each].
self
assert: (s hasEqualElements: i)!
----- Method: IntervalTest>>testReverseUnevenDo (in category 'tests') -----
testReverseUnevenDo
| s i |
s := OrderedCollection new.
i := 10 to: 20 by: 3.
i
reverseDo: [:each | s addFirst: each].
self
assert: (s hasEqualElements: i)!
----- Method: IntervalTest>>testUnevenDo (in category 'tests') -----
testUnevenDo
| s i |
s := OrderedCollection new.
i := 10 to: 20 by: 3.
i
do: [:each | s addLast: each].
self
assert: (s hasEqualElements: i)!
ClassTestCase subclass: #KeyedSetTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
!KeyedSetTest commentStamp: 'nice 5/22/2008 14:12' prior: 0!
KeyedSetTest hold sunit tests for class KeyedSet!
----- Method: KeyedSetTest>>testSelect (in category 'tests') -----
testSelect
"this is a non regression test for http://bugs.squeak.org/view.php?id=6535"
| ks ks2 |
"Creare a KeyedSet"
ks := KeyedSet keyBlock: [:e | e asInteger \\ 4].
ks addAll: #(1.2 1.5 3.8 7.7 9.1 12.4 13.25 14.0 19.2 11.4).
"There is non more than 4 possible keys (0 1 2 3)"
self assert: ks size <= 4.
"Select some elements"
ks2 := ks select: [:e | e fractionPart > 0.5].
"If keyBlock was preserved, then still no more than 4 keys..."
ks2 addAll: #(1.2 1.5 3.8 7.7 9.1 12.4 13.25 14.0 19.2 11.4).
self assert: ks2 size <= 4.!
ClassTestCase subclass: #LinkedListTest
instanceVariableNames: 'nextLink n list link1 link2 link3 link4'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
!LinkedListTest commentStamp: 'mk 8/3/2005 11:55' prior: 0!
A set of test cases which thoroughly test functionality of the LinkedList class.!
----- Method: LinkedListTest>>n (in category 'accessing') -----
n
^n!
----- Method: LinkedListTest>>n: (in category 'accessing') -----
n: number
n := number.
!
----- Method: LinkedListTest>>nextLink (in category 'accessing') -----
nextLink
^nextLink!
----- Method: LinkedListTest>>nextLink: (in category 'accessing') -----
nextLink: aLink
nextLink := aLink!
----- Method: LinkedListTest>>setUp (in category 'running') -----
setUp
super setUp.
list := LinkedList new.
link1 := Link new.
link2 := Link new.
link3 := Link new.
link4 := Link new!
----- Method: LinkedListTest>>tearDown (in category 'running') -----
tearDown
list := nil.
link1 := nil.
link2 := nil.
link3 := nil.
link4 := nil.
^ super tearDown!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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).!
----- 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).!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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!
----- 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].!
----- Method: LinkedListTest>>testAddAfter (in category 'tests') -----
testAddAfter
| 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).!
----- Method: LinkedListTest>>testAddAfterLast (in category 'tests') -----
testAddAfterLast
| 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).!
----- Method: LinkedListTest>>testAddAfterLast2 (in category 'tests') -----
testAddAfterLast2
"LinkedListTest new testAddAfterLast2"
| l first second third fourth |
l := LinkedList new.
first := self class new n: 1.
second := self class new n: 2.
third := self class new n: 3.
fourth :=self class new n: 4.
l addLast: first.
l addLast: second.
self assert: (l collect:[:e | e n]) asArray = #(1 2).
l add: third after: second.
self assert: (l collect:[:e | e n]) asArray = #(1 2 3).
l addLast: fourth.
self assert: (l collect:[:e | e n]) asArray = #(1 2 3 4).!
----- 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'!
ClassTestCase subclass: #MatrixTest
instanceVariableNames: 'matrix1 matrix2 matrix3'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
----- 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.!
----- Method: MatrixTest>>testAtAt (in category 'tests - accessing') -----
testAtAt
self should:[matrix1 at: 2 at: 3] raise: Error.
self should:[matrix1 at: 3 at: 2] raise: Error.
self should:[matrix1 at: 3 at: 3] raise: Error.
self should:[matrix1 at: 0 at: 1] raise: Error.
self should:[matrix1 at: 1 at: 0] raise: Error.
self should:[matrix1 at: 0 at: 0] raise: Error.
self assert: (matrix1 at: 1 at: 1) = 1!
----- Method: MatrixTest>>testCopy (in category 'tests - copying') -----
testCopy
| copyMatrix |
copyMatrix := matrix1 copy.
self assert: matrix1 = copyMatrix !
----- Method: MatrixTest>>testIncludes (in category 'tests - testing') -----
testIncludes
self assert:
((1 to: 4)
allSatisfy: [:i | matrix1 includes: i])
!
----- Method: MatrixTest>>testMultiply (in category 'tests - arithmetic') -----
testMultiply
| result |
self should: [matrix1 preMultiplyByMatrix: (Matrix new: 3)]raise: Error.
result := matrix2 preMultiplyByMatrix: matrix1.
self assert: (result at: 1 at: 1) = 15.
self assert: (result at: 1 at: 2) = 31.
self assert: (result at: 2 at: 1) = 22.
self assert: (result at: 2 at: 2) = 46!
----- Method: MatrixTest>>testReplaceAll (in category 'tests - accessing') -----
testReplaceAll
matrix1 replaceAll: 1 with: 10.
self assert: (matrix1 at:1 at:1) = 10.
self assert: (matrix1 at:2 at:1) = 2.
self assert: (matrix1 at:1 at:2) = 3.
self assert: (matrix1 at:2 at:2) = 4.!
----- Method: MatrixTest>>testSwap (in category 'tests - accessing') -----
testSwap
matrix1 swap: 1 at: 2 with: 1 at: 1.
self assert: (matrix1 at: 1 at: 1) = 3.
self assert: (matrix1 at: 1 at: 2) = 1.!
----- Method: MatrixTest>>testTransposed (in category 'tests - accessing') -----
testTransposed
| transposedMatrix |
transposedMatrix := matrix1 transposed.
self assert: [(transposedMatrix at:1 at:1) = 1].
self assert: [(transposedMatrix at:1 at:2) = 2].
self assert: [(transposedMatrix at:2 at:1) = 3].
self assert: [(transposedMatrix at:2 at:2) = 4].!
ClassTestCase subclass: #OrderedCollectionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
!OrderedCollectionTest commentStamp: 'BG 1/10/2004 22:07' prior: 0!
These test cases demonstrate addition of items into an OrderedCollection as well as item removal.
Some of the assertions are quite complicated and use a lot of collection protocol. Such methods do not test one single method, but protocol in general.!
----- 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).
!
----- 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).
!
----- Method: OrderedCollectionTest>>testAddAfterIndex (in category 'testsAdding') -----
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.
!
----- 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!
----- 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!
----- 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.
!
----- 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!
----- 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).
!
----- 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.
!
----- Method: OrderedCollectionTest>>testAddBeforeIndex (in category 'testsAdding') -----
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.
!
----- 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'))])!
----- 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).
!
----- 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.
!
----- 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')!
----- 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).
!
----- 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'!
----- 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.
self
shouldnt: [c at: 2 ifAbsentPut: [5]]
raise: Error.
self assert: c = #(1 2 3 4 ) asOrderedCollection.
c at: 5 ifAbsentPut: [5].
self assert: c = #(1 2 3 4 5 ) asOrderedCollection.
c at: 7 ifAbsentPut: [7].
self assert: c = #(1 2 3 4 5 nil 7 ) asOrderedCollection!
----- 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!
----- 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).
!
----- 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).!
----- 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.!
----- 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).!
----- 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.
!
----- 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.
!
----- 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.
!
----- 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"
self shouldnt: [c2 := c1 forceTo: 10 paddingWith: paddingElement] raise: Error.
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"
self shouldnt: [c2 := c1 forceTo: 3 paddingWith: paddingElement] raise: Error.
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"
self shouldnt: [c2 := c1 forceTo: 10 paddingStartWith: paddingElement] raise: Error.
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"
self shouldnt: [c2 := c1 forceTo: 3 paddingStartWith: paddingElement] raise: Error.
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).!
----- 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!
----- 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. "!
----- 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'
!
----- 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!
----- 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.
!
----- 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.
!
----- 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).!
----- 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.!
----- 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'!
----- 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)
!
----- 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.!
----- 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).
!
ClassTestCase subclass: #ReadWriteStreamTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Streams'!
!ReadWriteStreamTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class ReadWriteStream.
Unit tests are a good way to exercise the
functionality of your system in a repeatable and
automatic manner. They are therefore recommended if
you plan to release anything. For more information,
see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: ReadWriteStreamTest>>testConstructionUsingWith (in category 'tests') -----
testConstructionUsingWith
"Use the with: constructor."
| aStream |
aStream := ReadWriteStream with: #(1 2).
self assert: (aStream contents = #(1 2)) description: 'Ensure correct initialization.'!
----- Method: ReadWriteStreamTest>>testIsEmpty (in category 'tests - testing') -----
testIsEmpty
| stream |
stream := ReadWriteStream on: String new.
self assert: stream isEmpty.
stream nextPut: $a.
self deny: stream isEmpty.
stream reset.
self deny: stream isEmpty.
stream next.
self deny: stream isEmpty.!
----- Method: ReadWriteStreamTest>>testNew (in category 'tests') -----
testNew
self should: [ReadWriteStream new] raise: Error.!
ClassTestCase subclass: #SequenceableCollectionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Sequenceable'!
----- Method: SequenceableCollectionTest>>testAfterIfAbsent (in category 'testing - testing') -----
testAfterIfAbsent
| col |
col := #(2 3 4).
self assert: ((col after: 4 ifAbsent: ['block']) = 'block').
self assert: ((col after: 5 ifAbsent: ['block']) = 'block').
self assert: ((col after: 2 ifAbsent: ['block']) = 3).!
----- Method: SequenceableCollectionTest>>testAtAllPut (in category 'tests - accessing') -----
testAtAllPut
|table|.
table := Array new: 5.
table atAllPut: $a.
self assert: (table allSatisfy: [:elem | elem = $a])!
----- Method: SequenceableCollectionTest>>testBeforeIfAbsent (in category 'testing - testing') -----
testBeforeIfAbsent
| col |
col := #(2 3 4).
self assert: ((col before: 2 ifAbsent: ['block']) = 'block').
self assert: ((col before: 5 ifAbsent: ['block']) = 'block').
self assert: ((col before: 3 ifAbsent: ['block']) = 2).!
----- Method: SequenceableCollectionTest>>testBeginsWith (in category 'testing - testing') -----
testBeginsWith
"We can't test SequenceableCollection directly. However, we can test a sampling of its descendants."
| la prefix oc |
la := #(1 2 3 4 5 6).
oc := OrderedCollection new.
oc add: 1; add: 2; add: 3.
self assert: (la beginsWith: #(1)).
self assert: (la beginsWith: #(1 2)).
self assert: (la beginsWith: #(1 2 3)).
self assert: (la beginsWith: oc).
self deny: (la beginsWith: #()).
self deny: (la beginsWith: '').
self deny: (la beginsWith: OrderedCollection new).
self assert: (oc beginsWith: #(1 2)).
prefix := OrderedCollection new.
self deny: (oc beginsWith: prefix).
prefix add: 1.
self assert: (oc beginsWith: prefix).
prefix add: 2.
self assert: (oc beginsWith: prefix).
prefix add: 3.
self assert: (oc beginsWith: prefix).
prefix add: 4.
self deny: (oc beginsWith: prefix).!
----- Method: SequenceableCollectionTest>>testCopyWith (in category 'tests - copying') -----
testCopyWith
| table |
table := Array new: 4 withAll: 3.
self assert: table = #(3 3 3 3).
table := table copyWith: 4.
self assert: table = #(3 3 3 3 4).!
----- Method: SequenceableCollectionTest>>testEndsWith (in category 'testing - testing') -----
testEndsWith
"We can't test SequenceableCollection directly. However, we can test a sampling of its descendants."
| la oc suffix |
la := #(1 2 3 4 5 6).
oc := OrderedCollection new.
oc add: 4; add: 5; add: 6.
self assert: (la endsWith: #(6)).
self assert: (la endsWith: #(5 6)).
self assert: (la endsWith: #(4 5 6)).
self assert: (la endsWith: oc).
self deny: (la endsWith: #()).
self deny: (la endsWith: '').
suffix := OrderedCollection new.
suffix add: 6.
self assert: (oc endsWith: suffix).
suffix addFirst: 5.
self assert: (oc endsWith: suffix).
suffix addFirst: 4.
self assert: (oc endsWith: suffix).
suffix addFirst: 3.
self deny: (oc endsWith: suffix).!
----- Method: SequenceableCollectionTest>>testEvalStrings (in category 'tests - converting') -----
testEvalStrings
| table |
table := #('String new' 'Array with: 3 with: $a' '15+4').
table := table evalStrings.
self assert: table first isString.
self assert: table first isEmpty.
self assert: table second isArray.
self assert: table second first = 3.
self assert: table second second = $a.
self assert: table third = 19.!
----- Method: SequenceableCollectionTest>>testPreMultiplyByArray (in category 'tests - arithmetic') -----
testPreMultiplyByArray
| array|.
array := #(3).
self assert:(array preMultiplyByArray: 2)=6.
array := Array new: 4.
self should:[array preMultiplyByArray: 2] raise:Error.!
----- Method: SequenceableCollectionTest>>testPreMultiplyByMatrix (in category 'tests - arithmetic') -----
testPreMultiplyByMatrix
| array matrix result|.
array := #(1 2 3 4 5).
"( 1 2 3 4 5
10 20 30 40 50)"
matrix := Matrix
rows:2 columns:5 tabulate: [:row :column | row = 1
ifTrue: column
ifFalse: column * 10].
result := array preMultiplyByMatrix: matrix.
self assert: result isArray.
self assert: result size = 2.
self assert: result first = 55.
self assert: result second = 550.!
----- Method: SequenceableCollectionTest>>testPreMultiplyByMatrix2 (in category 'tests - arithmetic') -----
testPreMultiplyByMatrix2
| array matrix|.
array := #(1 2 3 4 5).
matrix := Matrix rows:1 columns:4 tabulate: [:row :column | column].
"Not compatible size"
self should:[array preMultiplyByMatrix: matrix] raise: Error.!
----- Method: SequenceableCollectionTest>>testReplaceFromToWithStartingAt (in category 'testing') -----
testReplaceFromToWithStartingAt
| string |
string := 'abcd' copy.
string replaceFrom: 1 to: 3 with: 'lmnop' startingAt: 1.
self assert: string = 'lmnd'.
string := 'abcd' copy.
string replaceFrom: 1 to: 3 with: 'lmnop' startingAt: 2.
self assert: string = 'mnod'.
string := 'abcd' copy.
string replaceFrom: 2 to: 3 with: 'lmnop' startingAt: 1.
self assert: string = 'almd'.!
ClassTestCase subclass: #SetTest
instanceVariableNames: 'full empty'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Unordered'!
!SetTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Set. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: SetTest>>setUp (in category 'running') -----
setUp
empty := Set new.
full := Set with: 5 with: #abc!
----- Method: SetTest>>tearDown (in category 'running') -----
tearDown
"I am called whenever your test ends.
I am the place where you release the ressources"!
----- Method: SetTest>>testAdd (in category 'Sunit original tests') -----
testAdd
empty add: 5.
self assert: (empty includes: 5).!
----- Method: SetTest>>testAddWithOccurences (in category 'tests') -----
testAddWithOccurences
empty add: 2 withOccurrences: 3.
self assert: (empty includes: 2).
self assert: ((empty occurrencesOf: 2) = 1).!
----- Method: SetTest>>testAsSet (in category 'tests') -----
testAsSet
"could be moved in Array or Collection"
| newFull |
newFull := #(#abc 5) asSet.
newFull add: 5.
self assert: (newFull = full).!
----- Method: SetTest>>testAtRandom (in category 'tests') -----
testAtRandom
| rand |
rand := Random new.
full add: 3.
full add: 2.
full add: 4.
full add: 1.
self assert: (full includes: (full atRandom: rand)).
!
----- Method: SetTest>>testCollect (in category 'tests') -----
testCollect
| newFull result |
newFull := Set withAll: (1 to: 10).
result := newFull collect: [:each | each >= 1 ifTrue: [each] ifFalse: ['no']].
self assert: (result = newFull).
result := newFull collect: [:each | each >= 5 ifTrue: [each] ifFalse: ['no']].
self assert: (result = ((Set withAll: (5 to: 10)) add: 'no'; yourself)).!
----- Method: SetTest>>testCopy (in category 'tests') -----
testCopy
| newFull |
full add: 3.
full add: 2.
newFull := full copy.
self assert: (full size = newFull size).
self assert: ((full select: [:each | (newFull includes: each) not]) isEmpty).
self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty).!
----- Method: SetTest>>testCopyWithout (in category 'tests') -----
testCopyWithout
| newFull |
full add: 3.
full add: 2.
newFull := full copyWithout: 3.
self assert: (newFull size = (full size - 1)).
self deny: (newFull includes: 3).
self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty).
self assert: ((full select: [:each | (newFull includes: each) not]) = (Set with: 3)).
!
----- Method: SetTest>>testDo (in category 'tests') -----
testDo
| newFull result |
newFull := Set withAll: (1 to: 5).
result := 0.
newFull do: [:each | result := (result + each)].
self assert: (result = 15).!
----- Method: SetTest>>testGrow (in category 'Sunit original tests') -----
testGrow
empty addAll: (1 to: 100).
self assert: (empty size = 100).
!
----- 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.
!
----- Method: SetTest>>testIncludes (in category 'Sunit original tests') -----
testIncludes
self assert: (full includes: 5).
self assert: (full includes: #abc).
self deny: (full includes: 3).
!
----- Method: SetTest>>testIntersection (in category 'tests') -----
testIntersection
| newFull col |
full add: 3; add: 2.
col := full intersection: full.
self assert: (full = col).
newFull := Set with: 8 with: 9 with: #z.
col := newFull intersection: full.
self assert: (col isEmpty).
newFull add: 5; add: #abc; add: 7.
col := newFull intersection: full.
self assert: ((full select: [:each | (newFull includes: each)]) = col).
!
----- Method: SetTest>>testLike (in category 'tests') -----
testLike
self assert: ((full like: 5) = 5).
self assert: ((full like: 8) isNil).!
----- 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).!
----- Method: SetTest>>testRemove (in category 'Sunit original tests') -----
testRemove
full remove: 5.
self assert: (full includes: #abc).
self deny: (full includes: 5).!
----- Method: SetTest>>testRemoveAll (in category 'tests') -----
testRemoveAll
"Allows one to remove all elements of a collection"
| c1 c2 s2 |
c1 := full.
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'.!
----- Method: SetTest>>testRemoveIfAbsent (in category 'tests') -----
testRemoveIfAbsent
| result1 result2 |
result1 := true.
result2 := true.
full remove: 8 ifAbsent: [ result1 := false ].
self assert: (result1 = false).
full remove: 5 ifAbsent: [ result2 := false ].
self assert: (result2 = true).
!
----- Method: SetTest>>testSize (in category 'tests') -----
testSize
self assert: (empty size = 0).
self assert: (full size = 2).
empty add: 2.
empty add: 1.
full add: 2.
self assert: (empty size = 2).
self assert: (full size = 3).
empty remove: 2.
self assert: (empty size = 1).!
----- Method: SetTest>>testUnion (in category 'tests') -----
testUnion
| newFull col newCol |
full add: 3.
full add: 2.
col := full union: full.
self assert: (full = col).
newFull := Set with: 8 with: 9 with: #z.
col := newFull union: full.
self assert: (col size = (full size + newFull size)).
self assert: ((col select: [:each | (full includes: each) not]) = newFull).
self assert: ((col select: [:each | (newFull includes: each) not]) = full).
full add: 9.
col := newFull union: full.
newCol := newFull copy.
newCol remove: 9.
self assert: (col size = (full size + newFull size - 1)).
self assert: ((col select: [:each | (full includes: each) not]) = newCol).
newCol := full copy.
newCol remove: 9.
self assert: ((col select: [:each | (newFull includes: each) not]) = newCol).
!
ClassTestCase subclass: #StringTest
instanceVariableNames: 'string'
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!StringTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class String. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: StringTest>>setUp (in category 'initialize-release') -----
setUp
string := 'Hi, I am a String'!
----- Method: StringTest>>testAsDecomposedUnicode (in category 'tests - converting') -----
testAsDecomposedUnicode
"Test the behavior of #asDecomposedUnicode"
| composed decomposed |
"Tests single character"
composed := String with: (Character value: 353).
decomposed := String with: (Character value: 115) with: (Character value: 780).
self assert: composed asDecomposedUnicode = decomposed.
"Test character at end of text"
composed := 'Hello', (String with: (Character value: 353)).
decomposed := 'Hello', (String with: (Character value: 115) with: (Character value: 780)).
self assert: composed asDecomposedUnicode = decomposed.
"Test character in the midst of text"
composed := 'Hello', (String with: (Character value: 353)), 'World'.
decomposed := 'Hello', (String with: (Character value: 115) with: (Character value: 780)), 'World'.
self assert: composed asDecomposedUnicode = decomposed.
"Test character in the end of text"
composed := (String with: (Character value: 353)), 'World'.
decomposed := (String with: (Character value: 115) with: (Character value: 780)), 'World'.
self assert: composed asDecomposedUnicode = decomposed.
"Test string full of characters"
"Test character in the end of text"
composed := (String with: (Character value: 353)).
decomposed := (String with: (Character value: 115) with: (Character value: 780)).
self assert: (composed, composed, composed) asDecomposedUnicode = (decomposed, decomposed, decomposed).
!
----- Method: StringTest>>testAsInteger (in category 'tests - converting') -----
testAsInteger
self assert: '1796exportFixes-tkMX' asInteger = 1796.
self assert: 'donald' asInteger isNil.
self assert: 'abc234def567' asInteger = 234.
self assert: '-94' asInteger = -94.
self assert: 'foo-bar-92' asInteger = -92!
----- Method: StringTest>>testAsPrecomposedUnicode (in category 'tests - converting') -----
testAsPrecomposedUnicode
"Test the behavior of #asPrecomposedUnicode"
| composed decomposed |
"Tests single character"
composed := String with: (Character value: 353).
decomposed := String with: (Character value: 115) with: (Character value: 780).
self assert: decomposed asPrecomposedUnicode = composed.
"Test character at end of text"
composed := 'Hello', (String with: (Character value: 353)).
decomposed := 'Hello', (String with: (Character value: 115) with: (Character value: 780)).
self assert: decomposed asPrecomposedUnicode = composed.
"Test character in the midst of text"
composed := 'Hello', (String with: (Character value: 353)), 'World'.
decomposed := 'Hello', (String with: (Character value: 115) with: (Character value: 780)), 'World'.
self assert: decomposed asPrecomposedUnicode = composed.
"Test character in the end of text"
composed := (String with: (Character value: 353)), 'World'.
decomposed := (String with: (Character value: 115) with: (Character value: 780)), 'World'.
self assert: decomposed asPrecomposedUnicode = composed.
"Test string full of characters"
"Test character in the end of text"
composed := (String with: (Character value: 353)).
decomposed := (String with: (Character value: 115) with: (Character value: 780)).
self assert: (decomposed, decomposed, decomposed) asPrecomposedUnicode = (composed, composed, composed).
!
----- Method: StringTest>>testAsSmalltalkComment (in category 'tests - converting') -----
testAsSmalltalkComment
| exampleStrings |
exampleStrings := #(
''
' '
'"'
'""'
'"""'
'abc"abc'
'abc""abc'
'abc"hello"abc'
'abc"'
'"abc' ).
"check that the result of scanning the comment is empty"
exampleStrings do: [ :s |
| tokens |
tokens := Scanner new scanTokens: s asSmalltalkComment.
self assert: (tokens isEmpty) ].
"check that the result has the same non-quote characters as the original"
exampleStrings do: [ :s |
self assert: ( (s copyWithout: $") = (s asSmalltalkComment copyWithout: $"))].
"finnaly, test for some common kinds of inputs"
self assert: ( 'abc' asSmalltalkComment = '"abc"').
self assert: ( 'abc"abc' asSmalltalkComment = '"abc""abc"').
self assert: ('abc""abc' asSmalltalkComment = '"abc""abc"' ).
!
----- Method: StringTest>>testAt (in category 'tests - accessing') -----
testAt
self assert: (string at: 1) = $H.!
----- Method: StringTest>>testBase64 (in category 'tests - converting') -----
testBase64
self assert: 'SGVsbG8gV29ybGQ=' base64Decoded = 'Hello World'.
self assert: 'Hello World' base64Encoded = 'SGVsbG8gV29ybGQ='.!
----- Method: StringTest>>testCapitalized (in category 'tests - converting') -----
testCapitalized
| uc lc empty |
uc := 'MElViN'.
lc := 'mElViN'.
empty := ' '.
self assert: lc capitalized = uc.
self assert: uc capitalized = uc.
"the string gets copied"
self deny: uc capitalized == uc.
self deny: empty capitalized == empty.!
----- Method: StringTest>>testComparing (in category 'test-comparing') -----
testComparing
self assert: 'foo' < 'foo:'.
self assert: 'foo' < 'fooBar'.
self assert: 'foo' <= 'foo:'.
self assert: 'foo' <= 'fooBar'.
self assert: 'foo:' > 'foo'.
self assert: 'fooBar' > 'foo'.
self assert: 'foo:' >= 'foo'.
self assert: 'fooBar' >= 'foo'!
----- Method: StringTest>>testEquality (in category 'as yet unclassified') -----
testEquality
self assert: 'abc' = 'abc' asWideString.
self assert: 'abc' asWideString = 'abc'.
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString ~= 'a000' asWideString).
self assert: ('a000' asWideString ~= (ByteArray with: 97 with: 0 with: 0 with: 0) asString).
self assert: ('abc' sameAs: 'aBc' asWideString).
self assert: ('aBc' asWideString sameAs: 'abc').
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString
sameAs: 'Abcd' asWideString) not.
self assert: ('a000' asWideString sameAs:
(ByteArray with: 97 with: 0 with: 0 with: 0) asString) not.!
----- Method: StringTest>>testFindLastOccuranceOfStringStartingAt (in category 'tests - finding') -----
testFindLastOccuranceOfStringStartingAt
self assert: ('Smalltalk' findLastOccuranceOfString: 'al' startingAt: 2) = 7.
self assert: ('aaa' findLastOccuranceOfString: 'aa' startingAt: 1) = 2.!
----- Method: StringTest>>testFindStringStartingAt (in category 'tests - finding') -----
testFindStringStartingAt
"Run the tests with both String's and ByteString's method"
{
"text pattern startIndex expectedResult"
#('Smalltalk' 'al' 2 3).
{ (Character value: 12345) asString, 'foo'. 'foo'. 1. 2 }.
{ (Character value: 12345) asString, 'foo'. (Character value: 12345) asString, 'foo'. 1. 1 }.
{ 'foo', (Character value: 12345) asString. (Character value: 12345) asString. 1. 4 }.
#('ababab' 'ab' 2 3).
#('abc' 'a' 2 0) } do: [ :input |
#(
(yourself yourself)
"the (yourself asWideString) pair would sometimes result 0
(like here: 'Smalltalk' findString: 'al' asWideString startingAt: 1)
if the text is a ByteString, because of the optimized version,
but normally ByteStrings never ''contain'' WideStrings"
(asWideString yourself)
(asWideString asWideString)) do: [ :modifiers |
| text pattern startIndex expectedResult result |
text := input first perform: modifiers first.
pattern := input second perform: modifiers second.
startIndex := input third.
expectedResult := input fourth.
self assert: (result := text findString: pattern startingAt: startIndex) = expectedResult ] ]!
----- Method: StringTest>>testFindTokensEscapedBy01 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy01
| tokens |
string := 'this, is, "a, test"'.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens size == 3!
----- Method: StringTest>>testFindTokensEscapedBy02 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy02
| tokens |
string := ''.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens isEmpty!
----- Method: StringTest>>testFindTokensEscapedBy03 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy03
| tokens |
string := 'this, is, a, test'.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens size == 4!
----- Method: StringTest>>testFindTokensEscapedBy04 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy04
| tokens |
string := 'this, is, a"," test'.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens size == 3.
self assert: tokens third = ' a, test'!
----- Method: StringTest>>testFindTokensEscapedBy05 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy05
| tokens |
string := 'this, /is, a"," test/'.
tokens := string findTokens: ',#' escapedBy: '"/'.
self assert: tokens size = 2.
self assert: tokens first = 'this'.
self assert: tokens second = ' is, a"," test'.!
----- Method: StringTest>>testFindTokensEscapedBy06 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy06
| tokens |
string := 'this, is, "a, test'.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens size == 3.
self assert: tokens third = ' a, test'!
----- Method: StringTest>>testFindTokensEscapedBy07 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy07
| tokens |
string := 'a:b::c'.
tokens := string findTokens: ':' escapedBy: '"'.
self assert: tokens size == 4.
self assert: tokens first = 'a'.
self assert: tokens second = 'b'.
self assert: tokens third = ''.
self assert: tokens fourth = 'c'!
----- Method: StringTest>>testFindTokensEscapedBy08 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy08
| tokens |
string := 'this, is, ##a, test'.
tokens := string findTokens: ',' escapedBy: '#'.
self assert: tokens size == 4.
self assert: tokens third = ' a'.
self assert: tokens fourth = ' test'!
----- Method: StringTest>>testFindTokensEscapedBy09 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy09
| tokens |
string := 'this, is, ###a, test#'.
tokens := string findTokens: ',' escapedBy: '#'.
self assert: tokens size == 3.
self assert: tokens third = ' #a, test'!
----- Method: StringTest>>testFindTokensEscapedBy10 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy10
| tokens |
string := 'this, is, ###a, test'.
tokens := string findTokens: ',' escapedBy: '#'.
self assert: tokens size == 3.
self assert: tokens third = ' #a, test'!
----- Method: StringTest>>testFindTokensEscapedBy11 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy11
| tokens |
string := 'this, is, """a, test"'.
tokens := string findTokens: ',' escapedBy: '"'.
self assert: tokens size == 3.
self assert: tokens third = ' "a, test'!
----- Method: StringTest>>testFindTokensEscapedBy12 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy12
| tokens |
string := 'one, two# three; four. five'.
tokens := string findTokens: ',#;.' escapedBy: '"'.
self assert: tokens size == 5.
self assert: tokens third = ' three'!
----- Method: StringTest>>testFindTokensEscapedBy13 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy13
| tokens |
string := 'one, two# three; four. five'.
tokens := string findTokens: ',#;.' escapedBy: nil.
self assert: tokens size == 5.
self assert: tokens third = ' three'!
----- Method: StringTest>>testFindTokensEscapedBy14 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy14
| tokens |
string := 'one, "two# three"; &four. five&'.
tokens := string findTokens: ',#;.' escapedBy: '"&'.
self assert: tokens size == 3.
self assert: tokens second = ' two# three'.
self assert: tokens third = ' four. five'!
----- Method: StringTest>>testFindTokensEscapedBy15 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy15
| tokens |
string := 'one, "two# three"; &four. five&'.
tokens := string findTokens: nil escapedBy: '"&'.
self assert: tokens size = 1.
self assert: tokens first = 'one, two# three; four. five'!
----- Method: StringTest>>testFindTokensEscapedBy16 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy16
| tokens |
string := 'one, "two# three"; &four. five&'.
tokens := string findTokens: nil escapedBy: nil.
self assert: tokens size = 1.
self assert: tokens first = string!
----- Method: StringTest>>testFindTokensEscapedBy21 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy21
| tokens |
string := 'this, is, "a, test"'.
tokens := string findTokens: $, escapedBy: $".
self assert: tokens size == 3!
----- Method: StringTest>>testFindTokensEscapedBy22 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy22
| tokens |
string := ''.
tokens := string findTokens: $, escapedBy: $".
self assert: tokens size = 0!
----- Method: StringTest>>testFindTokensEscapedBy23 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy23
| tokens |
string := 'this, is, a, test'.
tokens := string findTokens: $, escapedBy: $".
self assert: tokens size == 4!
----- Method: StringTest>>testFindTokensEscapedBy24 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy24
| tokens |
string := 'this, is, a"," test'.
tokens := string findTokens: $, escapedBy: $".
self assert: tokens size == 3.
self assert: tokens third = ' a, test'!
----- Method: StringTest>>testFindTokensEscapedBy25 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy25
| tokens |
string := 'this, /is, a"," test/'.
tokens := string findTokens: $, escapedBy: $/.
self assert: tokens size = 2.
self assert: tokens first = 'this'.
self assert: tokens second = ' is, a"," test'.!
----- Method: StringTest>>testFindTokensEscapedBy26 (in category 'testing - tokenizing') -----
testFindTokensEscapedBy26
| tokens |
string := 'this, is, "a, test'.
tokens := string findTokens: $, escapedBy: $".
self assert: tokens size == 3.
self assert: tokens third = ' a, test'!
----- Method: StringTest>>testFormat (in category 'testing - formatting') -----
testFormat
{
[ '\{ \} \\ foo {1} bar {2}' format: { 12. 'string' } ] -> '{ } \ foo 12 bar string'.
[ '\{ \} \\ foo {2} bar {1}' format: { 'string'. 12 } ] -> '{ } \ foo 12 bar string'.
[ '\{1}' format: {} ] -> '{1}'.
[ '\{1}{1}' format: { $a } ] -> '{1}a'.
} do: [ :each |
self assert: each key value = each value ]!
----- Method: StringTest>>testIndexOf (in category 'tests - indexOf') -----
testIndexOf
"test for http://bugs.impara.de/view.php?id=3574"
self assert: ('abc-' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 4.
self assert: ('ab7' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 3.
self assert: ('a2c' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 2.
self assert: ('3bc' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 1.
self assert: ('abc' asWideString indexOfAnyOf: (CharacterSet newFrom: ' -0123456789')) = 0.
"extension to wide characters"
self assert: ((String with: 803 asCharacter with: 811 asCharacter) indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: 812 asCharacter))) = 2.
self assert: ('abc' indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: 812 asCharacter))) = 0.
self assert: ('abc' indexOfAnyOf: (CharacterSet newFrom: (String with: 811 asCharacter with: $c))) = 3.
"make sure start index is used in wide string algorithm"
self assert: ('ab bcd abc' copyWith: 811 asCharacter) substrings = {'ab'. 'bcd'. 'abc' copyWith: 811 asCharacter}.!
----- Method: StringTest>>testPercentEncodingJa (in category 'testing - converting') -----
testPercentEncodingJa
| leading hiraA hiraO hiraAO encodedHiraA encodedHiraO encodedHiraAO |
"Make Japanese String from unicode. see http://www.unicode.org/charts/PDF/U3040.pdf"
leading := JapaneseEnvironment leadingChar.
hiraA := (Character leadingChar: leading code: 16r3042) asString. "HIRAGANA LETTER A"
hiraO := (Character leadingChar: leading code: 16r304A) asString. "HIRAGANA LETTER O"
hiraAO := hiraA, hiraO.
"Percent Encoded Japanese String"
encodedHiraA := hiraA encodeForHTTP.
self assert: encodedHiraA = '%E3%81%82'.
encodedHiraO := hiraO encodeForHTTP.
self assert: encodedHiraO = '%E3%81%8A'.
encodedHiraAO := hiraAO encodeForHTTP.
self assert: encodedHiraAO = '%E3%81%82%E3%81%8A'.
"without percent encoded string"
self assert: '' unescapePercents = ''.
self assert: 'abc' unescapePercents = 'abc'. "latin1 character"
self assert: hiraAO unescapePercents = hiraAO. "multibyte character"
"encoded latin1 string"
self assert: '%61' unescapePercents = 'a'.
self assert: '%61%62%63' unescapePercents = 'abc'.
"encoded multibyte string"
Locale currentPlatform: (Locale isoLanguage: 'ja') during: [
self assert: encodedHiraA unescapePercents = hiraA.
self assert: encodedHiraAO unescapePercents = hiraAO].
"mixed string"
Locale currentPlatform: (Locale isoLanguage: 'ja') during: [
self assert: (encodedHiraAO,'a') unescapePercents = (hiraAO, 'a').
self assert: ('a', encodedHiraA) unescapePercents = ('a', hiraA).
self assert: ('a', encodedHiraA, 'b') unescapePercents = ('a', hiraA, 'b').
self assert: ('a', encodedHiraA, 'b', encodedHiraO) unescapePercents = ('a', hiraA, 'b', hiraO).
self assert: (encodedHiraA, encodedHiraO, 'b', encodedHiraA) unescapePercents = (hiraA, hiraO, 'b', hiraA)].
"for Seaside"
Locale currentPlatform: (Locale isoLanguage: 'ja') during: [
self assert: (encodedHiraA, '+', encodedHiraO) unescapePercents = (hiraA, ' ', hiraO)].
!
----- Method: StringTest>>testSpace (in category 'testing - instance creation') -----
testSpace
"self debug: #testSpace"
string := String new.
self assert: string size = 0. "instead of #isEmpty to be consistent with the following test"
string := String space.
self assert: string size = 1.
self assert: string = ' '!
----- Method: StringTest>>testUnescapePercents (in category 'tests - converting') -----
testUnescapePercents
self assert: '' unescapePercents = ''.
self assert: 'x' unescapePercents = 'x'.
self assert: '+' unescapePercents = ' '.
self assert: 'x+' unescapePercents = 'x '.
self assert: '+x' unescapePercents = ' x'.
self assert: 'x+x' unescapePercents = 'x x'.
self assert: '%' unescapePercents = '%'.
self assert: '%3' unescapePercents = '%3'.
self assert: '%3C' unescapePercents = '<'.
self assert: '%3Cx%3E4%3C%2Fx%3E' unescapePercents = '<x>4</x>'.
self assert: '!!@#$%25%5E&*()%7B%7D%5B%5D=:/;?+''%22' unescapePercents = '!!@#$%^&*(){}[]=:/;? ''"'.
self assert: '!!%40%23%24%25%5E%26*()%7B%7D%5B%5D%3D%3A%2F%3B%3F%2B''%22' unescapePercents = '!!@#$%^&*(){}[]=:/;?+''"'.
self assert: '%21@%23%24%25%5E%26*%28%29%7B%7D%5B%5D%3D%3A/%3B%3F+%27%22' unescapePercents = '!!@#$%^&*(){}[]=:/;? ''"'!
----- Method: StringTest>>testUnescapePercentsWithTextEncoding (in category 'tests - converting') -----
testUnescapePercentsWithTextEncoding
| leading kataTe kataSu kataTo |
leading := JapaneseEnvironment leadingChar.
"Katakana letter Te"
kataTe := (Character leadingChar: leading code: 12486) asString.
"Katakana letter Su"
kataSu := (Character leadingChar: leading code: 12473) asString.
"Katakana letter To"
kataTo := (Character leadingChar: leading code: 12488) asString.
self assert: ('%83e%83X%83g' unescapePercentsWithTextEncoding: 'shift_jis')
= (kataTe , kataSu , kataTo).
self assert: ('%83e%83X%83g%20and%20%83e%83X%83g' unescapePercentsWithTextEncoding: 'shift_jis')
= (kataTe , kataSu , kataTo , ' and ' , kataTe , kataSu , kataTo)!
----- Method: StringTest>>testUpTo (in category 'tests - converting') -----
testUpTo
"self debug: #testUpTo"
self assert: #up:to: keywords = #(up: to:).
self assert: #copy:from:to: keywords = #(copy: from: to:).
self assert: #up keywords = #(up).
self assert: #at: keywords = #(at:).
!
----- Method: StringTest>>testWithBlanksTrimmed (in category 'testing - converting') -----
testWithBlanksTrimmed
| s |
self assert: ' abc d ' withBlanksTrimmed = 'abc d'.
self assert: 'abc d ' withBlanksTrimmed = 'abc d'.
self assert: ' abc d' withBlanksTrimmed = 'abc d'.
self assert: (((0 to: 255) collect: [ :each | each asCharacter ] thenSelect: [ :each | each isSeparator ]) as: String) withBlanksTrimmed = ''.
s := 'abcd'.
self assert: s withBlanksTrimmed = s.
self assert: s withBlanksTrimmed ~~ s.!
----- Method: StringTest>>testWithFirstCharacterDownshifted (in category 'tests - converting') -----
testWithFirstCharacterDownshifted
| uc lc empty |
uc := 'MElViN'.
lc := 'mElViN'.
empty := ' '.
self assert: uc withFirstCharacterDownshifted = lc.
self assert: lc withFirstCharacterDownshifted = lc.
"the string gets copied"
self deny: lc withFirstCharacterDownshifted == lc.
self deny: empty withFirstCharacterDownshifted == empty.!
----- Method: StringTest>>testZipped (in category 'tests - converting') -----
testZipped
| compressed |
compressed := 'hello' zipped.
self assert: (compressed unzipped = 'hello').!
ClassTestCase subclass: #SymbolTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!SymbolTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Symbol. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: SymbolTest>>testAsMutator (in category 'tests') -----
testAsMutator
self assert: #x asMutator = #x:.
self assert: #x asMutator isSymbol!
----- Method: SymbolTest>>testCapitalized (in category 'tests') -----
testCapitalized
| uc lc |
uc := #MElViN.
lc := #mElViN.
self assert: lc capitalized = uc.
self assert: uc capitalized = uc.
!
----- Method: SymbolTest>>testNumArgs2 (in category 'as yet unclassified') -----
testNumArgs2
"TODO: need to be extended to support shrinking and for selectors like #+ "
self assert: (#test numArgs: 0) = #test.
self assert: (#test numArgs: 1) = #test:.
self assert: (#test numArgs: 2) = #test:with:.
self assert: (#test numArgs: 3) = #test:with:with:.
self assert: (#test: numArgs: 0) = #test:.
self assert: (#test: numArgs: 1) = #test:.
self assert: (#test: numArgs: 2) = #test:with:.
self assert: (#test: numArgs: 3) = #test:with:with:.
self assert: (#test:with: numArgs: 0) = #test:with:.
self assert: (#test:with: numArgs: 1) = #test:with:.
self assert: (#test:with: numArgs: 2) = #test:with:.
self assert: (#test:with: numArgs: 3) = #test:with:with:.
self assert: (#test:with: numArgs: 4) = #test:with:with:with:.
self assert: (#test:with:with: numArgs: 0) = #test:with:with:.
self assert: (#test:with:with: numArgs: 1) = #test:with:with:.
self assert: (#test:with:with: numArgs: 2) = #test:with:with:.
self assert: (#test:with:with: numArgs: 3) = #test:with:with:.
self assert: (#test:with:with: numArgs: 4) = #test:with:with:with:.!
----- Method: SymbolTest>>testWithFirstCharacterDownshifted (in category 'tests') -----
testWithFirstCharacterDownshifted
| uc lc empty |
uc := #MElViN.
lc := #mElViN.
empty := #' '.
self assert: uc withFirstCharacterDownshifted = lc.
self assert: lc withFirstCharacterDownshifted = lc.
!
ClassTestCase subclass: #TextTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!TextTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class Text. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
ClassTestCase subclass: #WeakIdentityKeyDictionaryTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Weak'!
----- Method: WeakIdentityKeyDictionaryTest>>testNoNils (in category 'tests') -----
testNoNils
| d |
d := WeakIdentityKeyDictionary new
at: 'hello' copy put: 'world';
yourself.
Smalltalk garbageCollect.
self deny: (d keys includes: nil)!
ClassTestCase subclass: #WideStringTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Text'!
!WideStringTest commentStamp: '<historical>' prior: 0!
This is the unit test for the class String. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see:
- http://www.c2.com/cgi/wiki?UnitTest
- http://minnow.cc.gatech.edu/squeak/1547
- the sunit class category!
----- Method: WideStringTest>>testAsInteger (in category 'tests - converting') -----
testAsInteger
self assert: '1796exportFixes-tkMX' asWideString asInteger = 1796.
self assert: 'donald' asWideString asInteger isNil.
self assert: 'abc234def567' asWideString asInteger = 234.
self assert: '-94' asWideString asInteger = -94.
self assert: 'foo-bar-92' asWideString asInteger = -92.
self assert: '1796exportFixes-tkMX' asWideString asSignedInteger = 1796.
self assert: 'donald' asWideString asSignedInteger isNil.
self assert: 'abc234def567' asWideString asSignedInteger = 234.
self assert: '-94' asWideString asSignedInteger = -94.
self assert: 'foo-bar-92' asWideString asSignedInteger = -92.
self assert: '1796exportFixes-tkMX' asWideString asUnsignedInteger = 1796.
self assert: 'donald' asWideString asUnsignedInteger isNil.
self assert: 'abc234def567' asWideString asUnsignedInteger = 234.
self assert: '-94' asWideString asUnsignedInteger = 94.
self assert: 'foo-bar-92' asWideString asUnsignedInteger = 92!
----- Method: WideStringTest>>testAtPut (in category 'testing') -----
testAtPut
"Non regression test for http://bugs.squeak.org/view.php?id=6998"
| w1 |
w1 := WideString with: (Unicode value: 402) with: $a with: (Unicode value: 400) with: $b.
self assert: (w1 at: 2 put: $b) = $b description: 'at:put: should return the put-object'
!
----- Method: WideStringTest>>testBeginsWith (in category 'tests - beginsWith') -----
testBeginsWith
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
| w1 w2 |
self assert: ('abc' beginsWith: 'ab').
self assert: ('abc' beginsWith: 'ab' asWideString).
self assert: ('abc' asWideString beginsWith: 'ab').
self assert: ('abc' beginsWith: 'aX') not .
self assert: ('abc' beginsWith: 'AB') not.
self assert: ('abc' beginsWith: 'AB' asWideString) not .
self assert: ('ABC' asWideString beginsWith: 'ab') not.
w1 := WideString with: (Unicode value: 402) with: $a with: (Unicode value: 400) with: $b.
w2 := WideString with: (Unicode value: 402).
w1 beginsWith: w2.
!
----- Method: WideStringTest>>testCharactersExactlyMatching (in category 'tests - match') -----
testCharactersExactlyMatching
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('abc' charactersExactlyMatching: 'abc') = 3.
self assert: ('abd' charactersExactlyMatching: 'abc') = 2.
self assert: ('abc' charactersExactlyMatching: 'abc' asWideString) = 3.
self assert: ('abd' charactersExactlyMatching: 'abc' asWideString) = 2.
self assert: ('abc' asWideString charactersExactlyMatching: 'abc') = 3.
self assert: ('abd' asWideString charactersExactlyMatching: 'abc') = 2.
self assert: ('abc' asWideString charactersExactlyMatching: 'abc' asWideString) = 3.
self assert: ('abd' asWideString charactersExactlyMatching: 'abc' asWideString)= 2.
self assert: ('abc' charactersExactlyMatching: 'ABC') = 0.
!
----- Method: WideStringTest>>testCompare (in category 'tests - compare') -----
testCompare
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('abc' compare: 'abc') = 2.
self assert: ('abc' compare: 'abd') = 1.
self assert: ('abd' compare: 'abc') = 3.
self assert: ('abc' compare: 'abC') = 2.
self assert: ('abc' compare: 'abD') = 1.
self assert: ('abd' compare: 'abC') = 3.
self assert: ('aBc' compare: 'abC') = 2.
self assert: ('aBc' compare: 'abD') = 1.
self assert: ('aDd' compare: 'abC') = 3.
self assert: ('abc' compare: 'abc' asWideString) = 2.
self assert: ('abc' compare: 'abd' asWideString) = 1.
self assert: ('abd' compare: 'abc' asWideString) = 3.
self assert: ('abc' compare: 'abC' asWideString) = 2.
self assert: ('abc' compare: 'abD' asWideString) = 1.
self assert: ('abd' compare: 'abC' asWideString) = 3.
self assert: ('aBc' compare: 'abC' asWideString) = 2.
self assert: ('aBc' compare: 'abD' asWideString) = 1.
self assert: ('aDd' compare: 'abC' asWideString) = 3.
self assert: ('abc' asWideString compare: 'abc') = 2.
self assert: ('abc' asWideString compare: 'abd') = 1.
self assert: ('abd' asWideString compare: 'abc') = 3.
self assert: ('abc' asWideString compare: 'abC') = 2.
self assert: ('abc' asWideString compare: 'abD') = 1.
self assert: ('abd' asWideString compare: 'abC') = 3.
self assert: ('aBc' asWideString compare: 'abC') = 2.
self assert: ('aBc' asWideString compare: 'abD') = 1.
self assert: ('aDd' asWideString compare: 'abC') = 3.
self assert: ('abc' asWideString compare: 'abc' asWideString) = 2.
self assert: ('abc' asWideString compare: 'abd' asWideString) = 1.
self assert: ('abd' asWideString compare: 'abc' asWideString) = 3.
self assert: ('abc' asWideString compare: 'abC' asWideString) = 2.
self assert: ('abc' asWideString compare: 'abD' asWideString) = 1.
self assert: ('abd' asWideString compare: 'abC' asWideString) = 3.
self assert: ('aBc' asWideString compare: 'abC' asWideString) = 2.
self assert: ('aBc' asWideString compare: 'abD' asWideString) = 1.
self assert: ('aDd' asWideString compare: 'abC' asWideString) = 3.
self assert: ('abc' compare: 'abc' caseSensitive: true) = 2.
self assert: ('abc' compare: 'abC' caseSensitive: false) = 2.
self assert: ('abc' compare: 'abc' asWideString caseSensitive: true) = 2.
self assert: ('abc' compare: 'abC' asWideString caseSensitive: false) = 2.
self assert: ('abc' asWideString compare: 'abc' caseSensitive: true) = 2.
self assert: ('abc' asWideString compare: 'abC' caseSensitive: false) = 2.
self assert: ('abc' asWideString compare: 'abc' asWideString caseSensitive: true) = 2.
self assert: ('abc' asWideString compare: 'abC' asWideString caseSensitive: false) = 2.!
----- Method: WideStringTest>>testEndsWith (in category 'tests - endsWith') -----
testEndsWith
"Mix of tests from http://bugs.squeak.org/view.php?id=6366
#endsWith: was broken because using broken findSubstring
and tests from johnmci at http://bugs.squeak.org/view.php?id=5331"
| ws |
self assert: ('abc' endsWith: 'bc').
self assert: ('abc' endsWith: 'bc' asWideString).
self assert: ('abc' asWideString endsWith: 'bc').
self assert: ('abc' endsWith: 'bX') not.
self assert: ('abc' endsWith: 'BC') not.
self assert: ('abc' endsWith: 'BC' asWideString) not.
self assert: ('ABC' asWideString endsWith: 'bc') not.
self assert: ('Elvis' endsWith: 'vis').
self assert: ('Elvis' asWideString endsWith: 'vis').
self assert: ((WideString with: (Unicode value: 530)) , 'Elvis' endsWith: 'vis').
self deny: ('Elvis' endsWith: 'Vis').
self deny: ('Elvis' asWideString endsWith: 'vIs').
self deny: ((WideString with: (Unicode value: 530)) , 'Elvis' endsWith: 'viS').
ws := 'vis' , (WideString with: (Unicode value: 530)).
self deny: ('Elvis' endsWith: ws).
self assert: ('Elvis' , ws endsWith: ws).
self deny: ((WideString with: (Unicode value: 530)) , 'Elvis' endsWith: ws).
!
----- Method: WideStringTest>>testEqual (in category 'tests - compare') -----
testEqual
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: 'abc' = 'abc'.
self assert: 'abc' = 'abc' asWideString.
self assert: 'abc' asWideString = 'abc'.
self assert: 'abc' asWideString = 'abc' asWideString.
self assert: ('abc' = 'ABC') not.
self assert: ('abc' = 'ABC' asWideString) not.
self assert: ('abc' asWideString = 'ABC') not.
self assert: ('abc' asWideString = 'abc' asWideString).
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString ~= 'a000' asWideString).
self assert: ('a000' asWideString ~= (ByteArray with: 97 with: 0 with: 0 with: 0) asString).!
----- Method: WideStringTest>>testFindSubstring (in category 'tests - substrings') -----
testFindSubstring
"This is related to http://bugs.squeak.org/view.php?id=6366
finding substring in a WideString was broken because matchTable are byte-wise"
| ws1 ws2 |
self assert: ('abcd' findString: 'bc' startingAt: 1) = 2.
self assert: ('abcd' asWideString findString: 'bc' startingAt: 1) = 2.
self assert: ('abcd' findString: 'bc' asWideString startingAt: 1) = 2.
self assert: ('abcd' asWideString findString: 'bc' asWideString startingAt: 1) = 2.
ws1 := 'A' , (WideString with: (Unicode value: 530)) , 'BCD'.
self assert: (ws1 findString: 'bc' startingAt: 1 caseSensitive: true) = 0.
self assert: (ws1 findString: 'bc' startingAt: 1 caseSensitive: false) = 3.
ws2 := (WideString with: (Unicode value: 530)) , 'b'.
self assert: (ws1 findString: ws2 startingAt: 1 caseSensitive: true) = 0.
self assert: (ws1 findString: ws2 startingAt: 1 caseSensitive: false) = 2.
self assert: ('abc' findString: ws2 startingAt: 1 caseSensitive: true) = 0.
self assert: ('abc' findString: ws2 startingAt: 1 caseSensitive: false) = 0.!
----- Method: WideStringTest>>testMatch (in category 'tests - match') -----
testMatch
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('*baz' match: 'mobaz' ).
self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' ).
self assert: ('*baz' match: 'mobaz' ).
self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' ).
self assert: ('*baz' match: 'mobaz' asWideString).
self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' asWideString).
self assert: ('*baz' match: 'mobaz' asWideString).
self assert: ('*foo#zort' match: 'afoo3zortthenfoo3zort' asWideString).
self assert: ('*baz' asWideString match: 'mobaz' ).
self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' ).
self assert: ('*baz' asWideString match: 'mobaz' ).
self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' ).
self assert: ('*baz' asWideString match: 'mobaz' asWideString).
self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' asWideString).
self assert: ('*baz' asWideString match: 'mobaz' asWideString).
self assert: ('*foo#zort' asWideString match: 'afoo3zortthenfoo3zort' asWideString).!
----- Method: WideStringTest>>testRelationOrder (in category 'tests - relation order') -----
testRelationOrder
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('aa' < 'ab').
self assert: ('aa' <= 'ab').
self assert: ('aa' <= 'aa').
self assert: ('ab' > 'aa').
self assert: ('ab' >= 'aa').
self assert: ('aa' >= 'aa').
self assert: ('aa' < 'ab' asWideString).
self assert: ('aa' <= 'ab' asWideString).
self assert: ('aa' <= 'aa' asWideString).
self assert: ('ab' > 'aa' asWideString).
self assert: ('ab' >= 'aa' asWideString).
self assert: ('aa' >= 'aa' asWideString).
self assert: ('aa' asWideString < 'ab').
self assert: ('aa' asWideString <= 'ab').
self assert: ('aa' asWideString <= 'aa').
self assert: ('ab' asWideString > 'aa').
self assert: ('ab' asWideString >= 'aa').
self assert: ('aa' asWideString >= 'aa').
self assert: ('aa' asWideString< 'ab' asWideString).
self assert: ('aa' asWideString<= 'ab' asWideString).
self assert: ('aa' asWideString<= 'aa' asWideString).
self assert: ('ab' asWideString> 'aa' asWideString).
self assert: ('ab' asWideString >= 'aa' asWideString).
self assert: ('aa' asWideString>= 'aa' asWideString).!
----- Method: WideStringTest>>testRelationOrderWithCase (in category 'tests - relation order') -----
testRelationOrderWithCase
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('ABC' caseInsensitiveLessOrEqual: 'abc').
self assert: ('ABC' caseInsensitiveLessOrEqual: 'abd').
self assert: ('ABD' caseInsensitiveLessOrEqual: 'abc') not.
self assert: ('ABC' caseInsensitiveLessOrEqual: 'abc' asWideString).
self assert: ('ABC' caseInsensitiveLessOrEqual: 'abd' asWideString).
self assert: ('ABD' caseInsensitiveLessOrEqual: 'abc' asWideString) not.
self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abc').
self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abd').
self assert: ('ABD' asWideString caseInsensitiveLessOrEqual: 'abc') not.
self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abc' asWideString).
self assert: ('ABC' asWideString caseInsensitiveLessOrEqual: 'abd' asWideString).
self assert: ('ABD' asWideString caseInsensitiveLessOrEqual: 'abc' asWideString) not.
self assert: ('abc' caseSensitiveLessOrEqual: 'abc').
self assert: ('abc' caseSensitiveLessOrEqual: 'abd').
self assert: ('abd' caseSensitiveLessOrEqual: 'abc') not.
self assert: ('abc' caseSensitiveLessOrEqual: 'abc' asWideString).
self assert: ('abc' caseSensitiveLessOrEqual: 'abd' asWideString).
self assert: ('abd' caseSensitiveLessOrEqual: 'abc' asWideString) not.
self assert: ('abc' asWideString caseSensitiveLessOrEqual: 'abc').
self assert: ('abc' asWideString caseSensitiveLessOrEqual: 'abd').
self assert: ('abd' asWideString caseSensitiveLessOrEqual: 'abc') not.
self assert: ('abc' caseSensitiveLessOrEqual: 'ABC') not.
!
----- Method: WideStringTest>>testSameAs (in category 'tests - compare') -----
testSameAs
"from johnmci at http://bugs.squeak.org/view.php?id=5331"
self assert: ('abc' sameAs: 'aBc' asWideString).
self assert: ('aBc' asWideString sameAs: 'abc').
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString sameAs: 'Abcd' asWideString) not.
self assert: ('a000' asWideString sameAs: (ByteArray with: 97 with: 0 with: 0 with: 0) asString) not.
!
----- Method: WideStringTest>>testSubstrings (in category 'tests - substrings') -----
testSubstrings
"this is related to http://bugs.squeak.org/view.php?id=6367"
| w1 w2 |
w1 := WideString with: 401 asCharacter with: $a with: 402 asCharacter with: $b.
w2 := WideString with: 403 asCharacter with: 404 asCharacter.
self assert: w1 substrings first = w1.
self assert: (w1 , ' ' , w2) substrings size = 2.
self assert: (w1 , ' ' , w2) substrings last = w2.!
ClassTestCase subclass: #WriteStreamTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'CollectionsTests-Streams'!
----- Method: WriteStreamTest>>testCr (in category 'tests - character writing') -----
testCr
"self debug: #testCr"
| stream |
stream := WriteStream on: 'stream'.
stream cr.
self assert: stream last = Character cr.!
----- Method: WriteStreamTest>>testCrTab (in category 'tests - character writing') -----
testCrTab
"self debug: #testCrTab"
| stream |
stream := WriteStream on: 'stream'.
stream crtab.
self assert: (stream contents last: 2) = (String with: Character cr with: Character tab)!
----- Method: WriteStreamTest>>testCrTabs (in category 'tests - character writing') -----
testCrTabs
"self debug: #testCrTabs"
| stream |
stream := WriteStream on: 'stream'.
stream crtab: 2.
self assert: (stream contents last: 3) = (String with: Character cr with: Character tab with: Character tab)!
----- Method: WriteStreamTest>>testEnsureASpace (in category 'tests - character writing') -----
testEnsureASpace
"self debug: #testEnsureASpace"
| stream |
stream := WriteStream on: String new.
stream nextPutAll: 'this is a test'.
stream ensureASpace.
stream nextPutAll: 'for WriteStreamTest'.
self assert: stream contents = 'this is a test for WriteStreamTest'.
"Manually put a space and verify there are no 2 consecutive spaces"
stream := WriteStream on: String new.
stream nextPutAll: 'this is a test '.
stream ensureASpace.
stream nextPutAll: 'for WriteStreamTest'.
self assert: stream contents = 'this is a test for WriteStreamTest'.!
----- Method: WriteStreamTest>>testEnsureASpace2 (in category 'tests - character writing') -----
testEnsureASpace2
"self debug: #testEnsureASpace2"
| stream |
stream := WriteStream on: String new.
stream ensureASpace.
self assert: stream contents = ' '.
!
----- Method: WriteStreamTest>>testEnsureNoSpace (in category 'tests - character writing') -----
testEnsureNoSpace
"self debug: #testEnsureNoSpace"
| stream |
stream := WriteStream with: 'stream'.
stream ensureNoSpace.
self assert: stream contents = 'stream'.
stream := WriteStream with: 'stream '.
stream ensureNoSpace.
self assert: stream contents = 'stream'.
stream := WriteStream with: ' '.
stream ensureNoSpace.
self assert: stream contents = ''.!
----- Method: WriteStreamTest>>testInstanciationUsingOn (in category 'tests - instance creation') -----
testInstanciationUsingOn
"self debug: #testInstanciationUsingOn"
| stream |
stream := WriteStream on: #(1 2).
stream nextPut: 3.
self assert: stream contents = #(3)!
----- Method: WriteStreamTest>>testInstanciationUsingWith (in category 'tests - instance creation') -----
testInstanciationUsingWith
"self debug: #testInstanciationUsingWith"
| stream |
stream := WriteStream with: #(1 2).
stream nextPut: 3.
self assert: stream contents = #(1 2 3)!
----- Method: WriteStreamTest>>testIsEmpty (in category 'tests - testing') -----
testIsEmpty
| stream |
stream := WriteStream on: String new.
self assert: stream isEmpty.
stream nextPut: $a.
self deny: stream isEmpty.
stream reset.
self deny: stream isEmpty.!
----- Method: WriteStreamTest>>testIsEmpty2 (in category 'tests - testing') -----
testIsEmpty2
self assert: (WriteStream on: (String new: 100)) isEmpty!
----- Method: WriteStreamTest>>testNew (in category 'tests - instance creation') -----
testNew
self should: [WriteStream new] raise: Error. !
----- Method: WriteStreamTest>>testNextPut (in category 'tests - accessing') -----
testNextPut
"self debug: #testNextPut"
| stream |
stream := WriteStream on: String new.
stream
nextPut: $t;
nextPut: $e;
nextPut: $s;
nextPut: $t.
self assert: stream contents = 'test'!
----- Method: WriteStreamTest>>testNextPut2 (in category 'tests - accessing') -----
testNextPut2
"self debug: #testNextPut2"
| stream |
stream := WriteStream with: 'test'.
stream nextPut: $s.
self assert: stream contents = 'tests'!
----- Method: WriteStreamTest>>testNextPutAll (in category 'tests - accessing') -----
testNextPutAll
"self debug: #testNextPutAll"
| stream |
stream := WriteStream on: String new.
stream
nextPutAll: #($t $e $s $t).
self assert: stream contents = 'test'!
----- Method: WriteStreamTest>>testNextPutAllDifferentFromNextPuts (in category 'tests - instance creation') -----
testNextPutAllDifferentFromNextPuts
"self debug: #testNextPutAllDifferentFromNextPuts"
"When a stream is created on a collection, it tries to keep using that collection instead of copying. See thread with title 'Very strange bug on Streams and probably compiler' (Feb 14 2007) on the squeak-dev mailing list."
"nextPutAll verifies the size of the parameter and directly grows the underlying collection of the required size."
|string stream|
string := String withAll: 'z'.
stream := WriteStream on: string.
stream nextPutAll: 'abc'.
self assert: string = 'z'. "string hasn't been modified because #nextPutAll: detects that 'abc' is bigger than the underlying collection. Thus, it starts by creating a new collection and doesn't modify our variable."
string := String withAll: 'z'.
stream := WriteStream on: string.
stream nextPut: $a; nextPut: $b; nextPut: $c.
self assert: string = 'a'. "The first #nextPut: has no problem and replaces $z by $a in the string. Others will detect that string is too small."!
----- Method: WriteStreamTest>>testPosition (in category 'tests - positioning') -----
testPosition
"self debug: #testPosition"
| stream |
stream := WriteStream with: 'an elephant'.
stream position: 6.
self assert: stream contents = 'an ele'.
stream nextPutAll: 'vator'.
stream assert: stream contents = 'an elevator'!
----- Method: WriteStreamTest>>testPosition2 (in category 'tests - positioning') -----
testPosition2
"self debug: #testPosition2"
| stream |
stream := WriteStream with: ''.
self should: [stream position: 2] raise: Error.
self should: [stream position: -2] raise: Error.
stream := WriteStream with: 'a test'.
self shouldnt: [stream position: 2] raise: Error.
self should: [stream position: 7] raise: Error.
self should: [stream position: -2] raise: Error.!
----- Method: WriteStreamTest>>testReset (in category 'tests - positioning') -----
testReset
"self debug: #testReset"
|stream stream2|
stream := WriteStream with: 'a test ' copy.
stream reset.
stream nextPutAll: 'to test'.
self assert: stream contents = 'to test'.
stream2 := WriteStream with: 'a test ' copy.
stream2 nextPutAll: 'to test'.
self assert: stream2 contents = 'a test to test'!
----- Method: WriteStreamTest>>testSetToEnd (in category 'tests - accessing') -----
testSetToEnd
| string stream |
string := 'hello'.
stream := WriteStream with: ''.
stream nextPutAll: string.
self assert: stream position = string size.
stream setToEnd.
self assert: stream position = string size.
self assert: stream contents = string!
----- Method: WriteStreamTest>>testSize (in category 'tests - accessing') -----
testSize
"self debug: #testSize"
| string streamEmpty streamFull |
string := 'a string'.
streamEmpty := WriteStream on: string.
streamFull := WriteStream with: 'a string'.
self assert: streamEmpty size = 0.
self assert: streamFull size = 8.
streamEmpty nextPut: $..
streamFull nextPut: $..
self assert: streamEmpty size = 1.
self assert: streamFull size = (string size + 1).!
----- Method: WriteStreamTest>>testSpace (in category 'tests - character writing') -----
testSpace
"self debug: #testSpace"
| stream |
stream := WriteStream on: 'stream'.
stream space.
self assert: stream last = Character space.!
----- Method: WriteStreamTest>>testSpaces (in category 'tests - character writing') -----
testSpaces
"self debug: #testSpaces"
| stream |
stream := WriteStream on: 'stream'.
stream space: 3.
self assert: (stream contents last: 3) = ' '!
----- Method: WriteStreamTest>>testStreamUseGivenCollection (in category 'tests - instance creation') -----
testStreamUseGivenCollection
"self debug: #testStreamUseGivenCollection"
"When a stream is created on a collection, it tries to keep using that collection instead of copying. See thread with title 'Very strange bug on Streams and probably compiler' (Feb 14 2007) on the squeak-dev mailing list."
|string stream|
string := String withAll: 'erased'.
stream := WriteStream on: string.
self assert: string = 'erased'.
stream nextPutAll: 'test'.
self assert: string = 'tested'. "Begining of 'erased' has been replaced by 'test'".!
----- Method: WriteStreamTest>>testTab (in category 'tests - character writing') -----
testTab
"self debug: #testTab"
| stream |
stream := WriteStream on: 'stream'.
stream tab.
self assert: (stream contents last) = Character tab!
----- Method: WriteStreamTest>>testTabs (in category 'tests - character writing') -----
testTabs
"self debug: #testTabs"
| stream |
stream := WriteStream on: 'stream'.
stream tab: 3.
self assert: (stream contents last: 3) = (String with: Character tab with: Character tab with: Character tab)!
More information about the Packages
mailing list