RegressionTests__BlockTest.st
author Claus Gittinger <cg@exept.de>
Thu, 31 Aug 2000 13:12:02 +0200
changeset 70 c677f96c4a0b
parent 69 ffbf7492f5e5
child 95 362e58ff28ba
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
69
ffbf7492f5e5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 60
diff changeset
     1
"{ Package: 'exept:regression' }"
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
     3
"{ NameSpace: RegressionTests }"
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
     4
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
Object subclass:#BlockTest
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
59
5dfe7fc71559 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 58
diff changeset
     9
	category:'Tests-Regression'
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!BlockTest class methodsFor:'varArgBlocks'!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
getVarArgBlock1
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
     |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
     b := [:argList | Transcript 
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    19
			show:'invoked with args:'; 
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    20
			showCR:argList
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    21
	  ] asVarArgBlock.
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
     ^ b
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
getVarArgBlock2
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
     |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
     b := [:argList | Transcript 
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    31
			show:'invoked with args:'; 
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    32
			showCR:argList.
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    33
		      argList
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    34
	  ] asVarArgBlock.
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
     ^ b
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
getVarArgBlock3
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
     |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
     b := [:argList | Transcript 
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    44
			show:'invoked with args:'; 
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    45
			showCR:argList.
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    46
		      argList size
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    47
	  ] asVarArgBlock.
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
     ^ b
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
testAll
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
    self testVarArgBlocks.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
     self testAll
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
testVarArgBlock1
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    b := self getVarArgBlock1.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    b value.
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    67
    b code notNil ifTrue:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    68
	Transcript showCR:'blocks code is jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    69
    ] ifFalse:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    70
	Transcript showCR:'*** blocks code is NOT jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    71
    ].
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    72
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    73
    b value.
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
    b value:'arg1'.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    b value:'arg1' value:'arg2' value:'arg3' value:'arg4'
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
     self testVarArgBlock1
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
testVarArgBlock2
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
    b := self getVarArgBlock2.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    87
    b value.
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    88
    b code notNil ifTrue:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    89
	Transcript showCR:'blocks code is jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    90
    ] ifFalse:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
    91
	Transcript showCR:'*** blocks code is NOT jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    92
    ].
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
    93
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    b value     = #()  ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
    (b value:1) = #(1) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
    (b value:1 value:2) = #(1 2) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
    (b value:1 value:2 value:3) = #(1 2 3) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    (b value:1 value:2 value:3 value:4) = #(1 2 3 4) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
    (b valueWithArguments:#(1 2 3 4)) = #(1 2 3 4) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    (b perform:#value)     = #()  ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    (b perform:#'value:' with:1) = #(1) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    (b perform:#'value:value:' with:1 with:2) = #(1 2) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    (b perform:#'value:value:value:' with:1 with:2 with:3) = #(1 2 3) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
    (b perform:#'value:value:value:value:' with:1 with:2 with:3 with:4) = #(1 2 3 4) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    (b perform:#'valueWithArguments:' with:#(1 2 3 4)) = #(1 2 3 4) ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
     self testVarArgBlock2
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
testVarArgBlock3
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    |b|
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    b := self getVarArgBlock3.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
   118
    b value.
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
   119
    b code notNil ifTrue:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
   120
	Transcript showCR:'blocks code is jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
   121
    ] ifFalse:[
70
c677f96c4a0b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
   122
	Transcript showCR:'*** blocks code is NOT jitted'
60
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
   123
    ].
f23dd849290e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 59
diff changeset
   124
58
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    b value     = 0  ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
    (b value:1) = 1 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    (b value:1 value:2) = 2 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    (b value:1 value:2 value:3) = 3 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    (b value:1 value:2 value:3 value:4) = 4 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    (b valueWithArguments:#(1 2 3 4)) = 4 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    (b perform:#value)     = 0  ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
    (b perform:#'value:' with:1) = 1 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    (b perform:#'value:value:' with:1 with:2) = 2 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
    (b perform:#'value:value:value:' with:1 with:2 with:3) = 3 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
    (b perform:#'value:value:value:value:' with:1 with:2 with:3 with:4) = 4 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
    (b perform:#'valueWithArguments:' with:#(1 2 3 4)) = 4 ifFalse:[ self halt ].
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
     self testVarArgBlock3
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    "
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
testVarArgBlocks
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    self testVarArgBlock1.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
    self testVarArgBlock2.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    self testVarArgBlock3.
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
! !
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
!BlockTest class methodsFor:'documentation'!
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
version
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
    ^ '$Header$'
98b8f998027c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
! !