RegressionTests__ContextTest2.st
author Claus Gittinger <cg@exept.de>
Thu, 10 Jan 2002 01:56:16 +0100
changeset 147 ad483efa672a
parent 102 f9c4503da06d
child 180 5bd01bf41c4e
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'exept:regression' }"
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: RegressionTests }"
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
TestCase subclass:#ContextTest2
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'Tests-Regression'
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!ContextTest2 methodsFor:'tests'!
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
147
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    15
downToNextSegmentThenDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    16
    self 
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    17
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    18
        thenDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    19
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    20
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    21
     self new testUnwind1
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    22
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    23
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    24
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    25
downToNextSegmentThenUnwindAndDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    26
    self 
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    27
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    28
        thenUnwindAndDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    29
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    30
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    31
     self new testUnwind2
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    32
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    33
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    34
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    35
downToSegment:nr thenDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    36
    Processor activeProcess numberOfStackSegments >= nr ifTrue:[
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    37
        ^  aBlock value
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    38
    ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    39
    self 
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    40
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    41
        thenDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    42
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    43
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    44
     self new testUnwind1
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    45
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    46
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    47
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    48
downToSegment:nr thenUnwindAndDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    49
    Processor activeProcess numberOfStackSegments >= nr ifTrue:[
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    50
        aBlock home unwindThenDo: aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    51
    ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    52
    self 
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    53
        downToSegment:(Processor activeProcess numberOfStackSegments + 1)
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    54
        thenUnwindAndDo:aBlock
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    55
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    56
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    57
     self new testUnwind2
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    58
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    59
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
    60
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
testProcess1
101
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    62
    |x set lockSet p arg|
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    63
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    64
    lockSet := Semaphore forMutualExclusion.
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    65
    set := Set new.
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    66
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    67
    x := 1 @ 1.
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    68
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    69
    arg := x.
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    70
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    71
    p := [
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    72
        [
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    73
            lockSet critical:[set add:arg].
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    74
            arg perform:#x .
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    75
        ] valueNowOrOnUnwindDo:[
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    76
            lockSet critical:[set remove:arg].
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    77
        ].
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    78
    ] fork.
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    79
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    80
    "
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    81
     self new testProcess1
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    82
    "
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    83
!
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    84
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    85
testProcess2
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
    |x set lockSet p|
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
    lockSet := Semaphore forMutualExclusion.
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
    set := Set new.
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
    x := 1 @ 1.
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
    p := [:arg |
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
        [
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
            lockSet critical:[set add:arg].
102
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
    96
            arg perform:#x.
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
        ] valueNowOrOnUnwindDo:[
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
            lockSet critical:[set remove:arg].
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
        ].
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    ] forkWith:(Array with:x).
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    "
101
7ea8b99a38d8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
   103
     self new testProcess2
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    "
102
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   105
!
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   106
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   107
testProcess3
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   108
    |x set lockSet p|
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   109
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   110
    lockSet := Semaphore forMutualExclusion.
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   111
    set := Set new.
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   112
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   113
    x := 1 @ 1.
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   114
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   115
    p := [:arg |
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   116
        [
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   117
            lockSet critical:[set add:arg].
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   118
            arg perform:#x: with:1234.
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   119
        ] valueNowOrOnUnwindDo:[
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   120
            lockSet critical:[set remove:arg].
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   121
        ].
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   122
    ] forkWith:(Array with:x).
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   123
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   124
    "
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   125
     self new testProcess3
f9c4503da06d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 101
diff changeset
   126
    "
147
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   127
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   128
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   129
testUnwind1
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   130
    Transcript showCR:'1'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   131
    self downToNextSegmentThenDo:[Transcript showCR:'2'. ^  self ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   132
    Transcript showCR:'3'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   133
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   134
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   135
     self new testUnwind1
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   136
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   137
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   138
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   139
testUnwind2
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   140
    Transcript showCR:'1'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   141
    self downToNextSegmentThenUnwindAndDo:[Transcript showCR:'2'. ^  self ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   142
    Transcript showCR:'3'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   143
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   144
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   145
     self new testUnwind2
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   146
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   147
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   148
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   149
testUnwind3
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   150
    <context: #return>
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   151
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   152
    |foo|
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   153
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   154
    Transcript showCR:'1'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   155
    self downToNextSegmentThenUnwindAndDo:[Transcript showCR:'2'. foo := #foo ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   156
    Transcript showCR:'3'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   157
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   158
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   159
     self new testUnwind3
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   160
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   161
!
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   162
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   163
testUnwind4
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   164
    |foo|
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   165
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   166
    Transcript showCR:'1'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   167
    self downToNextSegmentThenDo:[Transcript showCR:'2'. foo := #foo ].
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   168
    Transcript showCR:'3'.
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   169
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   170
    "
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   171
     self new testUnwind4
ad483efa672a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 102
diff changeset
   172
    "
100
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
! !
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
!ContextTest2 class methodsFor:'documentation'!
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
version
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
    ^ '$Header$'
34d87daf0f75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
! !