"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#BlockTest

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression'

!

!BlockTest methodsFor:'varArgBlocks'!

getBlock1

     |b|

     b := [:arg | Transcript 

                        show:'invoked with arg:'; 

                        showCR:arg

          ].

     ^ b

!

getVarArgBlock1

     |b|

     b := [:argList | Transcript 

			show:'invoked with args:'; 

			showCR:argList

	  ] asVarArgBlock.

     ^ b

!

getVarArgBlock2

     |b|

     b := [:argList | Transcript 

			show:'invoked with args:'; 

			showCR:argList.

		      argList

	  ] asVarArgBlock.

     ^ b

!

getVarArgBlock3

     |b|

     b := [:argList | Transcript 

			show:'invoked with args:'; 

			showCR:argList.

		      argList size

	  ] asVarArgBlock.

     ^ b

!

testBlock1

    |b|

    b := self getBlock1.

    b code notNil ifTrue:[

        Transcript showCR:'before call: *** blocks code is jitted'

    ] ifFalse:[

        Transcript showCR:'before call: blocks code is NOT jitted'

    ].

    b value:nil.

    b code notNil ifTrue:[

        Transcript showCR:'after call: blocks code is jitted'

    ] ifFalse:[

        Transcript showCR:'after call: *** blocks code is NOT jitted'

    ].

    b value:#foo.

    b value:1.

    b value:2

    "

     self new testBlock1

    "

!

testVarArgBlock1

    |b|

    b := self getVarArgBlock1.

    b value.

    b code notNil ifTrue:[

        Transcript showCR:'blocks code is jitted'

    ] ifFalse:[

        Transcript showCR:'*** blocks code is NOT jitted'

    ].

    b value.

    b value:'arg1'.

    b value:'arg1' value:'arg2' value:'arg3' value:'arg4'

    "

     self new testVarArgBlock1

    "

!

testVarArgBlock2

    |b|

    b := self getVarArgBlock2.

    b value.

    b code notNil ifTrue:[

        Transcript showCR:'blocks code is jitted'

    ] ifFalse:[

        Transcript showCR:'*** blocks code is NOT jitted'

    ].

    self assert:( b value     = #() ).

    self assert:( (b value:1) = #(1) ).

    self assert:( (b value:1 value:2) = #(1 2) ).

    self assert:( (b value:1 value:2 value:3) = #(1 2 3) ).

    self assert:( (b value:1 value:2 value:3 value:4) = #(1 2 3 4) ).

    self assert:( (b valueWithArguments:#(1 2 3 4)) = #(1 2 3 4) ).

    self assert:( (b perform:#value)     = #()  ).

    self assert:( (b perform:#'value:' with:1) = #(1) ).

    self assert:( (b perform:#'value:value:' with:1 with:2) = #(1 2) ).

    self assert:( (b perform:#'value:value:value:' with:1 with:2 with:3) = #(1 2 3) ).

    self assert:( (b perform:#'value:value:value:value:' with:1 with:2 with:3 with:4) = #(1 2 3 4) ).

    self assert:( (b perform:#'valueWithArguments:' with:#(1 2 3 4)) = #(1 2 3 4) ).

    "

     self new testVarArgBlock2

    "

!

testVarArgBlock3

    |b|

    b := self getVarArgBlock3.

    b value.

    b code notNil ifTrue:[

        Transcript showCR:'blocks code is jitted'

    ] ifFalse:[

        Transcript showCR:'*** blocks code is NOT jitted'

    ].

    self assert:( b value     = 0  ).

    self assert:( (b value:1) = 1  ).

    self assert:( (b value:1 value:2) = 2 ).

    self assert:( (b value:1 value:2 value:3) = 3 ).

    self assert:( (b value:1 value:2 value:3 value:4) = 4 ).

    self assert:( (b valueWithArguments:#(1 2 3 4)) = 4 ).

    self assert:( (b perform:#value)     = 0  ).

    self assert:( (b perform:#'value:' with:1) = 1 ).

    self assert:( (b perform:#'value:value:' with:1 with:2) = 2 ).

    self assert:( (b perform:#'value:value:value:' with:1 with:2 with:3) = 3 ).

    self assert:( (b perform:#'value:value:value:value:' with:1 with:2 with:3 with:4) = 4 ).

    self assert:( (b perform:#'valueWithArguments:' with:#(1 2 3 4)) = 4 ).

    "

     self new testVarArgBlock3

    "

!

xtestAll

    self testVarArgBlocks.

    "

     self new xtestAll

    "

!

xtestVarArgBlocks

    self testVarArgBlock1.

    self testVarArgBlock2.

    self testVarArgBlock3.

! !

!BlockTest class methodsFor:'documentation'!

version

    ^ '$Header$'

! !