RegressionTests__ManyProcessesTest.st
author ca
Sat, 01 Feb 2003 14:25:13 +0100
changeset 177 874799ec846c
parent 176 fecc9fedafde
child 178 abfcc1ebc983
permissions -rw-r--r--
*** empty log message ***

"{ Package: 'exept:regression' }"

Object subclass:#ManyProcessesTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'AAA'
!


!ManyProcessesTest methodsFor:'test'!

start:count
"
self start:100
"
    |waitSema|

    waitSema := Semaphore new.
    waitSema setCount:(1 - count).

    count timesRepeat:[
        [ [Delay waitForSeconds:0.4.] ensure:[waitSema signal].
        ] forkAt:(Processor userBackgroundPriority)
    ].
    waitSema wait.
    Transcript showCR:'done'.
!

test400
    "
     self new test400
    "
    |waitSema repeat|

    repeat := 4.

    'Makefile' asFilename readStream close.

    waitSema := Semaphore new.
    waitSema setCount:(1 - repeat).

    repeat timesRepeat:[
        [ [self start:100] ensure:[waitSema signal] 
        ] forkAt:8.
    ].
    waitSema wait
! !

!ManyProcessesTest class methodsFor:'documentation'!

version
    ^ '$Header$'
! !