author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Wed, 29 Jun 2016 21:40:53 +0100 | |
branch | jv |
changeset 1499 | 26a16a04219b |
parent 696 | bc607ac0acd5 |
child 1500 | d406a10b2965 |
permissions | -rw-r--r-- |
1499
26a16a04219b
Package renamed from exept:regression to stx:goodies/regression. Hooray!
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
696
diff
changeset
|
1 |
"{ Package: 'stx:goodies/regression' }" |
105 | 2 |
|
96 | 3 |
"{ NameSpace: RegressionTests }" |
105 | 4 |
|
5 |
TestCase subclass:#DelayTest |
|
6 |
instanceVariableNames:'' |
|
7 |
classVariableNames:'' |
|
8 |
poolDictionaries:'' |
|
181 | 9 |
category:'tests-Regression' |
96 | 10 |
! |
105 | 11 |
|
106 | 12 |
|
586 | 13 |
!DelayTest class methodsFor:'others'! |
14 |
||
15 |
version_CVS |
|
16 |
^ '$Header$' |
|
17 |
! ! |
|
18 |
||
19 |
!DelayTest class methodsFor:'queries'! |
|
20 |
||
21 |
coveredClasses |
|
22 |
^ Array with:Delay |
|
23 |
||
24 |
"Created: / 05-07-2011 / 09:51:28 / cg" |
|
25 |
! ! |
|
26 |
||
105 | 27 |
!DelayTest methodsFor:'tests'! |
28 |
||
96 | 29 |
test1 |
650 | 30 |
|n verbose| |
31 |
||
32 |
verbose := false. |
|
55 | 33 |
|
96 | 34 |
[ |
35 |
n := 0. |
|
36 |
[n < 10] whileTrue:[ |
|
106 | 37 |
Delay waitForSeconds:0.1. |
650 | 38 |
verbose ifTrue:[ Transcript showCR:n ]. |
96 | 39 |
n := n + 1. |
40 |
] |
|
105 | 41 |
] forkAt:(Processor activePriority - 1). |
42 |
||
696 | 43 |
self assert:(n == nil). "because the process has lower prio and should not run" |
105 | 44 |
|
696 | 45 |
Delay waitForSeconds:0.05. |
105 | 46 |
|
696 | 47 |
self assert:(n == 0). "because I should have interrupted the process" |
105 | 48 |
|
106 | 49 |
Delay waitForSeconds:1.5. |
105 | 50 |
|
696 | 51 |
self assert:(n == 10). "because process should be complete now" |
105 | 52 |
|
53 |
" |
|
54 |
self basicNew test1 |
|
55 |
" |
|
650 | 56 |
|
57 |
"Modified: / 10-01-2012 / 19:25:22 / cg" |
|
105 | 58 |
! |
59 |
||
60 |
test2 |
|
650 | 61 |
|n verbose| |
62 |
||
63 |
verbose := false. |
|
682 | 64 |
n := 0. |
105 | 65 |
[ |
66 |
[n < 10] whileTrue:[ |
|
106 | 67 |
Delay waitForSeconds:0.1. |
650 | 68 |
verbose ifTrue:[ Transcript showCR:n ]. |
105 | 69 |
n := n + 1. |
70 |
] |
|
71 |
] forkAt:(Processor activePriority + 1). |
|
72 |
||
626 | 73 |
self assert:(n == 0) description:'thread with delays should not have started yet'. |
106 | 74 |
Delay waitForSeconds:1.1. |
626 | 75 |
self assert:(n == 10) description:('thread with delays should have finished by now (n=%d)' bindWith:n). |
105 | 76 |
|
77 |
" |
|
78 |
self basicNew test2 |
|
79 |
" |
|
626 | 80 |
|
650 | 81 |
"Modified: / 10-01-2012 / 19:25:35 / cg" |
592 | 82 |
! |
83 |
||
84 |
test3_longDelay |
|
85 |
"in stx6.2.1, the following does not wait, due to an overflow in |
|
86 |
the millisecond computation..." |
|
87 |
||
88 |
|stillWaiting watchDogBite| |
|
89 |
||
90 |
[ |
|
91 |
watchDogBite := false. |
|
92 |
stillWaiting := true. |
|
93 |
Delay waitForSeconds:1000000. |
|
94 |
stillWaiting := false. |
|
95 |
] valueWithWatchDog:[ watchDogBite := true] afterMilliseconds:1000. |
|
96 |
||
97 |
self assert:stillWaiting. |
|
98 |
self assert:watchDogBite. |
|
99 |
||
100 |
" |
|
101 |
self basicNew test3_longDelay |
|
102 |
" |
|
103 |
||
104 |
"Created: / 31-07-2011 / 18:44:53 / cg" |
|
645 | 105 |
! |
106 |
||
107 |
test4 |
|
108 |
"check that we can wake up early" |
|
109 |
||
110 |
|longDelay waitTime watchDogBite| |
|
111 |
||
112 |
longDelay := Delay forSeconds:1000000. |
|
113 |
[ |
|
114 |
Delay waitForSeconds:2. |
|
115 |
longDelay resume. |
|
116 |
] fork. |
|
117 |
||
118 |
waitTime := Time secondsToRun:[ |
|
119 |
"never wait longer than 10 seconds" |
|
120 |
[ |
|
121 |
longDelay wait. |
|
122 |
] valueWithWatchDog:[ watchDogBite := true] afterMilliseconds:10000. |
|
123 |
]. |
|
124 |
self assert:watchDogBite ~~ true. |
|
125 |
self assert:waitTime < 10. |
|
126 |
||
127 |
" |
|
128 |
self basicNew test4 |
|
129 |
" |
|
96 | 130 |
! ! |
105 | 131 |
|
106 | 132 |
!DelayTest class methodsFor:'documentation'! |
133 |
||
134 |
version |
|
135 |
^ '$Header$' |
|
136 |
! ! |