"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#BlockTest
instanceVariableNames:'process'
classVariableNames:''
poolDictionaries:''
category:'tests-Regression-RuntimeSystem'
!
!BlockTest methodsFor:'helpers - eqeq defect'!
g
^ True "/ the class here
"Created: / 31-08-2007 / 17:40:37 / cg"
!
h
^ True "/ the class here
"Created: / 31-08-2007 / 17:40:39 / cg"
! !
!BlockTest methodsFor:'helpers - mkreal defect'!
backgroundBlockWithMethodReturningHelper
"/ had this bug in one situation:
"/ a block was forked away
"/ the method returns (its context is moved from the stack to the heap)
"/ the block sees wrong method-vars
|var1 var2 var3 var4 backgroundAction sema|
sema := Semaphore new.
backgroundAction :=
[
var1 := self getMeVar:1 sema:sema.
self assert:(var1 = #[1]).
var2 := self getMeVar:2 sema:sema.
self assert:(var2 = #[2]).
var3 := self getMeVar:3 sema:sema.
self assert:(var3 = #[3]).
var4 := self getMeVar:4 sema:sema.
self assert:(var4 = #[4]).
sema signal.
].
process := backgroundAction newProcess.
process priority:3.
process resume.
^ sema
"Created: / 02-08-2011 / 18:56:44 / cg"
!
getMeVar:arg sema:sema
|t|
t := ByteArray with:arg.
sema wait.
%{
__markInterrupted(__context);
%}.
^ t
"Created: / 02-08-2011 / 18:57:20 / cg"
! !
!BlockTest methodsFor:'initialize / release'!
tearDown
|p|
(p := process) notNil ifTrue:[
process := nil.
p terminate.
]
"Created: / 03-08-2011 / 15:11:11 / cg"
! !
!BlockTest methodsFor:'tests - eqeq defects'!
testBlockWithEQEQ_1
|b v|
b := [ self g == self h ].
v := b value.
self assert:(v == true).
"
self new testBlockWithEQEQ_1
"
"Created: / 31-08-2007 / 17:41:59 / cg"
!
testBlockWithEQEQ_2
|b v|
b := [
%{
#ifdef FOO
%}.
self thisIsNeverCalled.
%{
#endif
%}.
self g == self h
].
v := b value.
self assert:(v == true).
"
self new testBlockWithEQEQ_2
"
"Created: / 31-08-2007 / 17:42:02 / cg"
!
testBlockWithEQEQ_3
|b p v|
p := self.
[
b := [
%{
#ifdef FOO
%}.
self thisIsNeverCalled.
%{
#endif
%}.
p g == p h
].
] value.
v := b value.
self assert:(v == true).
"
self new testBlockWithEQEQ_3
"
"Created: / 31-08-2007 / 17:44:07 / cg"
!
testBlockWithEQEQ_4
|b p v Tmp|
p := self.
[
b := [ |foo|
%{
#ifdef FOO
%}.
foo := Timestamp now.
Tmp isNil ifTrue:[
Tmp := 'flags' copy.
] ifFalse:[
ObjectMemory stopBackgroundCollector.
].
self thisIsNeverCalled.
%{
#endif
%}.
p g == p h
].
] perform:((Base64Coder decode:'dmFsdWU=') asString asSymbol).
v := b value.
self assert:(v == true).
"
self new testBlockWithEQEQ_4
"
"Created: / 31-08-2007 / 17:44:38 / cg"
! !
!BlockTest methodsFor:'tests - mkreal defect'!
testBackgroundBlockWithMethodReturning
"/ had this bug in one situation:
"/ a block was forked away
"/ the method returns (its context is moved from the stack to the heap)
"/ the block sees wrong method-vars
|sema|
sema := self backgroundBlockWithMethodReturningHelper.
sema signal.
sema wait.
"Created: / 02-08-2011 / 20:00:44 / cg"
! !
!BlockTest methodsFor:'tests - unwind actions'!
test_unwind1
|trace firstEntry callCount ensureCount|
trace := OrderedCollection new.
firstEntry := true.
callCount := ensureCount := 0.
trace add:10.
[:restart |
trace add:15.
[
trace add:20.
callCount := callCount + 1.
firstEntry ifTrue:[
trace add:21.
firstEntry := false.
restart value.
trace add:22.
].
] ensure:[
trace add:30.
ensureCount := ensureCount + 1.
].
trace add:40.
] valueWithRestart.
self assert:(callCount == 2).
self assert:(ensureCount == 2).
self assert:(trace asArray = #(10 15 20 21 30 15 20 30 40)).
!
test_unwind2
<context: #return>
|mark trace firstEntry callCount ensureCount kon|
kon := thisContext.
mark isNil ifTrue:[
mark := true.
trace := OrderedCollection new.
firstEntry := true.
callCount := ensureCount := 0.
trace add:5.
].
trace add:10.
[
trace add:20.
callCount := callCount + 1.
firstEntry ifTrue:[
trace add:21.
firstEntry := false.
kon unwindAndRestart.
trace add:22.
].
] ensure:[
trace add:30.
ensureCount := ensureCount + 1.
].
trace add:40.
self assert:(callCount == 2).
self assert:(ensureCount == 2).
self assert:(trace asArray = #(5 10 20 21 30 10 20 30 40)).
! !
!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.
nil
] asVarArgBlock.
^ b
"Modified: / 11-10-2017 / 15:44:34 / cg"
!
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 assert:(b value) isNil.
self assert:(b value:1) isNil.
self assert:(b value:1 value:2) isNil.
"
self new testVarArgBlock1
"
"Modified: / 11-10-2017 / 15:44:09 / cg"
!
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) ).
"/ someone known to be stc-compiled and sending value: is collect:
"/ (here, collects the arguments passed to b)
self assert: ( #(0 0 0) collect:b ) = #((0) (0) (0)).
"
self new testVarArgBlock2
"
"Modified: / 11-10-2017 / 15:43:19 / cg"
!
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 ).
"/ someone known to be stc-compiled and sending value: is collect:
"/ (here, collects the number of arguments passed to b)
self assert: ( #(0 0 0) collect:b ) = #(1 1 1).
"
self new testVarArgBlock3
"
"Modified: / 11-10-2017 / 15:42:39 / cg"
!
xtestAll
self testVarArgBlocks.
"
self new xtestAll
"
!
xtestVarArgBlocks
self testVarArgBlock1.
self testVarArgBlock2.
self testVarArgBlock3.
! !
!BlockTest class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !