"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#CollectionTests

	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-dictionary'!

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

    "

! !

!CollectionTests methodsFor:'tests-general'!

doTestGeneralCollectionOperationsIn:aClass

    |coll|

    coll := aClass new.

    self assert: ( coll size == 0 ).

    self assert: ( coll isEmpty ).

    self assert: ( coll notEmpty not ).

    self assert: ( coll isEmptyOrNil ).

    self assert: ( coll notEmptyOrNil not ).

    self should: [ coll first ] raise:Error.

    self should: [ coll last ] raise:Error.

    self should: [ (coll at:1) ] raise:Error.

    self assert: ( (coll includes:0) not ).

    "

     self basicNew testGeneralOperations

    "

!

testGeneralOperations

    |classes|

    classes := OrderedCollection new.

    classes 

        add:RunArray;

        add:Bag;

        add:Set;

        add:IdentitySet;

        add:Dictionary;

        add:IdentityDictionary;

        add:OrderedCollection;

        add:SortedCollection;

        add:Queue;

        add:Stack;

        add:SortedCollection;

        add:OrderedDictionary;

        add:OrderedSet.

    classes do:[:eachClass |

        self doTestGeneralCollectionOperationsIn:eachClass

    ].

    "

     self basicNew testGeneralOperations

    "

! !

!CollectionTests methodsFor:'tests-interval'!

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

    "

! !

!CollectionTests methodsFor:'tests-orderedset'!

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

    "

! !

!CollectionTests methodsFor:'tests-sorting'!

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$'

! !