"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#BecomeTests
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!


!BecomeTests methodsFor:'tests'!

testBecome
    "Test the two way become. Note. we cannot use string literals for this test"

    | a b c d |

    a := c := '123' copy.
    b := d := 'cd' copy.

    a become: b.

    self 
        assert: a = 'cd';
        assert: b = '123';
        assert: c = 'cd';
        assert: d = '123'.


    "
     self new testBecome
    "
!

testBecomeForward
    "Test the forward become."

    | a b c d |

    a := 'ab' copy.
    b := 'cd' copy.
    c := a.
    d := b.

    a becomeForward: b.

    self 
        assert: a = 'cd';
        assert: b = 'cd';
        assert: c = 'cd';
        assert: d = 'cd'.


    "
     self new testBecomeForward
    "
!

testBecomeForwardDontCopyIdentityHash
    "Check that
        1. the argument to becomeForward: is NOT modified to have the receiver's identity hash.
        2. the receiver's identity hash is unchanged."

    | a b hb |

    a := 'ab' copy.
    b := 'cd' copy.
    hb := b identityHash.

    a becomeForward: b copyHash: false.

    self 
        assert: a identityHash = hb;
        assert: b identityHash = hb.

    "
     self new testBecomeForwardDontCopyIdentityHash
    "
!

testBecomeForwardHash
    | a b c hb |

    a := 'ab' copy.
    b := 'cd' copy.
    c := a.
    hb := b hash.

    a becomeForward: b.

    self 
        assert: a hash = hb;
        assert: b hash = hb;
        assert: c hash = hb.

    "
     self new testBecomeForwardHash
    "
!

testBecomeForwardIdentityHash
    "Check that
            1. the argument to becomeForward: is modified to have the receiver's identity hash.
            2. the receiver's identity hash is unchanged."

    | a b ha |

    a := 'ab' copy.
    b := 'cd' copy.
    ha := a identityHash.

    a becomeForward: b.

    self 
        assert: a identityHash = ha;
        assert: b identityHash = ha.


    "
     self new testBecomeForwardIdentityHash
    "
!

testBecomeHash

    | a b c d ha hb |

    a := c := 'ab' copy.
    b := d := 'cd' copy.

    ha := a hash.
    hb := b hash.

    a become: b.

    self 
        assert: a = 'cd';
        assert: b = 'ab';
        assert: c = 'cd';
        assert: d = 'ab';
        assert: a hash = hb;
        assert: b hash = ha;
        assert: c hash = hb;
        assert: d hash = ha.


    "
     self new testBecomeHash
    "
!

testBecomeIdentityHash
    "Note. The identity hash of both objects seems to change after the become:"

    | a b c d |

    a := 'ab' copy.
    b := 'cd' copy.
    c := a.
    d := b.

    a become: b.

    self 
        assert: a identityHash = c identityHash;
        assert: b identityHash = d identityHash;
        deny: a identityHash = b identityHash.

    "
     self new testBecomeIdentityHash
    "
! !

!BecomeTests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !