author | Claus Gittinger <cg@exept.de> |
Sat, 13 Jul 2019 14:16:52 +0200 | |
changeset 2330 | c7cb74c4ed7b |
parent 2170 | b3a0090f56bb |
permissions | -rw-r--r-- |
1447 | 1 |
"{ Package: 'stx:goodies/regression' }" |
167 | 2 |
|
3 |
"{ NameSpace: RegressionTests }" |
|
4 |
||
5 |
TestCase subclass:#ProcessTest |
|
168 | 6 |
instanceVariableNames:'subProcesses' |
167 | 7 |
classVariableNames:'' |
8 |
poolDictionaries:'' |
|
2048 | 9 |
category:'tests-Regression-Processes' |
167 | 10 |
! |
11 |
||
12 |
||
2170 | 13 |
!ProcessTest methodsFor:'initialize / release'! |
167 | 14 |
|
15 |
tearDown |
|
16 |
||
1447 | 17 |
subProcesses notEmptyOrNil ifTrue:[ |
18 |
subProcesses do:[:aProcess| |
|
19 |
aProcess terminate. |
|
20 |
]. |
|
167 | 21 |
]. |
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
22 |
|
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
23 |
"Modified: / 19-09-2014 / 13:27:14 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
2170 | 24 |
! ! |
25 |
||
26 |
!ProcessTest methodsFor:'test'! |
|
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
27 |
|
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
28 |
testMaxProcessId |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
29 |
"This test makes sure a process id never exeeds MaxProcessId." |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
30 |
|
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
31 |
| blocker lastId maxId iters | |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
32 |
|
1198
513228267cb7
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1197
diff
changeset
|
33 |
|
1447 | 34 |
self |
35 |
skipIf: Processor maxProcessId > 500000 |
|
36 |
description: 'Processor maxProcessId is huge, would take really a long time'. |
|
1198
513228267cb7
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1197
diff
changeset
|
37 |
|
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
38 |
blocker := Semaphore new. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
39 |
lastId := Processor activeProcess id. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
40 |
maxId := Processor maxProcessId. |
1198
513228267cb7
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1197
diff
changeset
|
41 |
|
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
42 |
iters := 0. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
43 |
[ lastId ~~ maxId ] whileTrue:[ |
1447 | 44 |
[ lastId := Processor activeProcess id. blocker signal ] fork. |
45 |
blocker wait. |
|
46 |
iters := iters + 1. |
|
47 |
iters > maxId ifTrue:[ |
|
48 |
"/ OK, we tried long enough. The system is probably already |
|
49 |
"/ reusing Process id's so it may never reach maxId. |
|
50 |
^ self. |
|
51 |
]. |
|
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
52 |
]. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
53 |
"/ OK, we reached the limit. Try once again to spawn a new |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
54 |
"/ thread and assert its id is smaller then the limit. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
55 |
[ lastId := Processor activeProcess id. blocker signal ] fork. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
56 |
blocker wait. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
57 |
|
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
58 |
self assert: lastId < maxId. |
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
59 |
|
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
60 |
"Created: / 19-09-2014 / 12:50:04 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
1198
513228267cb7
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1197
diff
changeset
|
61 |
"Modified (format): / 19-09-2014 / 14:06:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
167 | 62 |
! |
63 |
||
168 | 64 |
testTerminateWithAllSubProcesses |
167 | 65 |
|
66 |
| block masterTask allProcesses| |
|
67 |
||
68 |
subProcesses := OrderedCollection new. |
|
1447 | 69 |
block := [ |
70 |
1 to:10 do:[:index| |
|
71 |
|subTask| |
|
72 |
subTask := [[true] whileTrue:[]] newProcess. |
|
73 |
subTask name:'TestTask no:', index asString. |
|
74 |
subTask priority:4. |
|
75 |
subProcesses add:subTask. |
|
76 |
subTask resume. |
|
77 |
]. |
|
78 |
[true] whileTrue:[Delay waitForSeconds:10]. |
|
167 | 79 |
]. |
80 |
||
81 |
masterTask := block newProcess. |
|
169 | 82 |
masterTask beGroupLeader. |
167 | 83 |
masterTask priority:8. |
84 |
masterTask name:'masterTask'. |
|
85 |
masterTask resume. |
|
86 |
||
87 |
Delay waitForSeconds:0.5. |
|
88 |
||
673
77426f9a7124
changed: #testTerminateWithAllSubProcesses
Stefan Vogel <sv@exept.de>
parents:
181
diff
changeset
|
89 |
masterTask terminateWithAllSubprocessesInGroup. |
1447 | 90 |
masterTask waitUntilTerminated. |
169 | 91 |
|
92 |
Delay waitForSeconds:1. |
|
93 |
allProcesses := ProcessorScheduler knownProcesses asOrderedCollection select:[:p | p isDead not]. |
|
167 | 94 |
subProcesses do:[:aProcess| |
1447 | 95 |
self should:((allProcesses includes:aProcess) not). |
167 | 96 |
]. |
169 | 97 |
|
98 |
" |
|
99 |
self new testTerminateWithAllSubProcesses |
|
100 |
" |
|
167 | 101 |
! ! |
102 |
||
103 |
!ProcessTest class methodsFor:'documentation'! |
|
104 |
||
105 |
version |
|
106 |
^ '$Header$' |
|
107 |
! ! |
|
1197
643aed971b66
class: RegressionTests::ProcessTest
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
673
diff
changeset
|
108 |