"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#DelayTest

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-Processes'

!

!DelayTest class methodsFor:'queries'!

coveredClasses

    ^ Array with:Delay

    "Created: / 05-07-2011 / 09:51:28 / cg"

! !

!DelayTest methodsFor:'tests'!

test1

    |n verbose delayMultiplier|

    verbose := false.

    "/ sorry, but the test machines are much too slow, give them more time

"/    delayMultiplier := 1.

    delayMultiplier := 2.

    [

        n := 0.

        [n < 10] whileTrue:[

           Delay waitForSeconds:(delayMultiplier * 0.1).

           verbose ifTrue:[ Transcript showCR:n ].

           n := n + 1.

        ]

    ] forkAt:(Processor activePriority - 1).

    self assert:(n == nil).     "because the process has lower prio and should not run"

    Delay waitForSeconds:(delayMultiplier * 0.05).

    self assert:(n == 0).       "because I should have interrupted the process"

    Delay waitForSeconds:(delayMultiplier * 1.5).

    self assert:(n == 10).      "because process should be complete now"

    "

     self basicNew test1

    "

    "Modified: / 10-01-2012 / 19:25:22 / cg"

    "Modified: / 28-03-2019 / 10:57:26 / Claus Gittinger"

!

test2

    |n verbose delayMultiplier|

    "/ sorry, but the test machines are much too slow, give them more time

    delayMultiplier := 5.   

"/    delayMultiplier := 1.

    verbose := false.

    n := 0.

    [

        [n < 10] whileTrue:[

           Delay waitForSeconds:(delayMultiplier * 0.1).

           verbose ifTrue:[ Transcript showCR:n ].

           n := n + 1.

        ]

    ] forkAt:(Processor activePriority + 1).

    self assert:(n == 0) description:'thread with delays should not have started yet, because its first action is a delay'.

    Delay waitForSeconds:(delayMultiplier * 1.1).

    self assert:(n == 10) description:('thread with delays should have finished by now (n=%d)' bindWith:n).

    "

     self basicNew test2

    "

    "Modified: / 10-01-2012 / 19:25:35 / cg"

    "Modified: / 28-03-2019 / 10:57:36 / Claus Gittinger"

    "Modified: / 03-05-2019 / 10:52:32 / Stefan Reise"

!

test3_longDelay

    "in stx6.2.1, the following does not wait, due to an overflow in

     the millisecond computation..."

    |stillWaiting watchDogBite|

    [

        watchDogBite := false.

        stillWaiting := true.

        Delay waitForSeconds:1000000.

        stillWaiting := false.

    ] valueWithWatchDog:[ watchDogBite := true] afterMilliseconds:500.

    self assert:stillWaiting.

    self assert:watchDogBite.

    "

     self basicNew test3_longDelay

    "

    "Created: / 31-07-2011 / 18:44:53 / cg"

    "Modified: / 28-03-2019 / 10:57:49 / Claus Gittinger"

!

test4

    "check that we can wake up early and the watchdog does not bite"

    |longDelay waitTime watchDogBite|

    longDelay := Delay forSeconds:1000000.

    [

        Delay waitForSeconds:0.5.

        longDelay resume.

    ] fork.

    waitTime := Time millisecondsToRun:[

        "never wait longer than 10 seconds"

        [

            longDelay wait.

        ] valueWithWatchDog:[ watchDogBite := true] afterMilliseconds:3000.

    ].

    self assert:watchDogBite ~~ true.

    self assert:waitTime < 600.

    "

     self basicNew test4

    "

    "Modified: / 29-03-2019 / 12:03:32 / Claus Gittinger"

!

test5

    "check that a watchdog does bark"

    |longDelay waitTime watchDogBite|

    longDelay := Delay forSeconds:1000000.

    waitTime := Time millisecondsToRun:[

        "never wait longer than 10 seconds"

        [

            longDelay wait.

        ] valueWithWatchDog:[ watchDogBite := true] afterMilliseconds:500.

    ].

    self assert:watchDogBite == true.

    self assert:waitTime < 600.

    "

     self basicNew test5

    "

    "Created: / 29-03-2019 / 12:02:46 / Claus Gittinger"

! !

!DelayTest class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !