"{ Package: 'exept:regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#CollectionTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'tests-Regression'
!
Object subclass:#SortTestData
instanceVariableNames:'value order'
classVariableNames:''
poolDictionaries:''
privateIn:CollectionTests
!
!CollectionTests class methodsFor:'documentation'!
documentation
"
documentation to be added.
[author:]
Claus Gittinger (cg@alan)
[see also:]
[instance variables:]
[class variables:]
"
!
history
"Created: / 8.11.2001 / 08:17:09 / cg"
! !
!CollectionTests methodsFor:'tests'!
testDictionary01
|d v1 v2 v3|
d := Dictionary new.
d at:1 put:(v1 := 'one').
d at:2 put:(v2 := 'two').
d at:3 put:(v3 := 'three').
self assert: ( d size == 3 ).
self assert: ( (d at:1) == v1 ).
self assert: ( (d at:2) == v2 ).
self assert: ( (d at:3) == v3 ).
d at:3 put:(v3 := 'drei').
self assert: ( d size == 3 ).
self assert: ( (d at:1) == v1 ).
self assert: ( (d at:2) == v2 ).
self assert: ( (d at:3) == v3 ).
self assert: ( (d keyAtValue:v1) = 1 ).
"
self basicNew testDictionary01
"
!
testInterval01
|i|
i := 1 to:10.
self assert: ( i size == 10 ).
self assert: ( i includes:1 ).
self assert: ( i includes:10 ).
self assert: ( i min == 1 ).
self assert: ( i max == 10 ).
"cannot add/remove"
self should:[i add:99] raise:Error.
self should:[i remove:10] raise:Error.
"
self basicNew testInterval01
"
!
testOrderedSet01
|s v1 v2 v3|
s := OrderedSet new.
s add:(v1 := 'one').
s add:(v2 := 'two').
s add:(v3 := 'three').
self assert: ( s size == 3 ).
self assert: ( (s at:1) == v1 ).
self assert: ( (s at:2) == v2 ).
self assert: ( (s at:3) == v3 ).
self assert: ( s includes:v1 ).
self assert: ( s includes:v2 ).
self assert: ( s includes:v3 ).
self assert: ( s includes:v1 copy).
self assert: ( s includes:v2 copy).
self assert: ( s includes:v3 copy).
"already in - adding again should not change things"
s add:v1.
self assert: ( s size == 3 ).
self assert: ( (s at:1) == v1 ).
self assert: ( (s at:2) == v2 ).
self assert: ( (s at:3) == v3 ).
"set i.e. not identitySet - adding copy should not change things"
s add:v1 copy.
self assert: ( s size == 3 ).
self assert: ( (s at:1) == v1 ).
self assert: ( (s at:2) == v2 ).
self assert: ( (s at:3) == v3 ).
s remove:v1.
self assert: ( s size == 2 ).
self assert: ( (s at:1) == v2 ).
self assert: ( (s at:2) == v3 ).
self assert: ( s includes:v1 ) not.
self assert: ( s includes:v2 ).
self assert: ( s includes:v3 ).
self assert: ( s includes:v1 copy) not.
self assert: ( s includes:v2 copy).
self assert: ( s includes:v3 copy).
s add:v1.
self assert: ( s size == 3 ).
self assert: ( (s at:1) == v2 ).
self assert: ( (s at:2) == v3 ).
self assert: ( (s at:3) == v1 ).
self assert: ( s includes:v1 ).
self assert: ( s includes:v2 ).
self assert: ( s includes:v3 ).
self assert: ( s includes:v1 copy).
self assert: ( s includes:v2 copy).
self assert: ( s includes:v3 copy).
s removeLast.
self assert: ( s size == 2 ).
self assert: ( (s at:1) == v2 ).
self assert: ( (s at:2) == v3 ).
self assert: ( s includes:v1 ) not.
self assert: ( s includes:v2 ).
self assert: ( s includes:v3 ).
self assert: ( s includes:v1 copy) not.
self assert: ( s includes:v2 copy).
self assert: ( s includes:v3 copy).
"
self basicNew testOrderedSet01
"
!
testSort01
| col errs last |
col := SortedCollection new addAll: (100 to: 1 by: -1); yourself.
last := nil.
errs := col inject: 0 into:
[ :totIn :n | |totOut|
totOut := totIn.
last notNil ifTrue: [ last > n ifTrue: [ totOut := totOut + 1 ] ].
last := n.
totOut ].
self should: [ errs = 0 ]
"
self basicNew testSort01
"
!
testSortStability01
"Verify that the sort is stable"
| testData col lastTestData errs |
testData := OrderedCollection new.
testData addAll: ((100 to: 1 by: -1) collect: [ :n | SortTestData new value: n ]).
testData addAll: ((100 to: 1 by: -1) collect: [ :n | SortTestData new value: n ]).
testData addAll: ((100 to: 1 by: -1) collect: [ :n | SortTestData new value: n ]).
1 to: testData size do: [ :i | (testData at: i) order: i ].
col := (SortedCollection new sortBlock: [ :v1 :v2 | v1 value <= v2 value ]) addAll: testData.
lastTestData := nil.
errs := col inject: 0 into:
[ :totIn :aSortTestData | |totOut|
totOut := totIn.
lastTestData notNil ifTrue:
[ lastTestData value = aSortTestData value ifTrue:
[ lastTestData order > aSortTestData order ifTrue: [ totOut := totOut + 1 ] ] ].
lastTestData := aSortTestData.
totOut ].
self should: [ errs = 0 ]
"
self basicNew testSortStability01
"
!
testSortStability02
"Verify that the sort is stable"
| testData col lastTestData errs |
testData := OrderedCollection new.
(25 to: 1 by: -1) do: [ :i | 1 to: 100 do: [ :j | testData add: (SortTestData new value: i ) ] ].
1 to: testData size do: [ :i | (testData at: i) order: i ].
col := (SortedCollection new sortBlock: [ :v1 :v2 | v1 value <= v2 value ]) addAll: testData.
lastTestData := nil.
errs := col inject: 0 into:
[ :totIn :aSortTestData | |totOut|
totOut := totIn.
lastTestData notNil ifTrue:
[ lastTestData value = aSortTestData value ifTrue:
[ lastTestData order > aSortTestData order ifTrue: [ totOut := totOut + 1 ] ] ].
lastTestData := aSortTestData.
totOut ].
self should: [ errs = 0 ]
"
self basicNew testSortStability02
"
! !
!CollectionTests::SortTestData methodsFor:'accessing'!
value
"Answer the value of the receiver's ''value'' instance variable."
^value
!
value: anObject
"Set the value of the receiver's ''value'' instance variable to the argument, anObject."
value := anObject
! !
!CollectionTests::SortTestData methodsFor:'order'!
order
"Answer the value of the receiver's ''order'' instance variable."
^order
!
order: anObject
"Set the value of the receiver's ''order'' instance variable to the argument, anObject."
order := anObject
! !
!CollectionTests::SortTestData methodsFor:'printing & storing'!
printOn: aStream
super printOn: aStream.
aStream
nextPutAll: '(value: ';
nextPutAll: value printString;
nextPutAll: ' order: ';
nextPutAll: order printString;
nextPut: $)
! !
!CollectionTests class methodsFor:'documentation'!
version
^ '$Header$'
! !