RegressionTests__ManyProcessesTest.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 02 Jan 2018 16:29:05 +0000
branchjv
changeset 1966 99c870d21885
parent 1567 e17701a073f9
permissions -rw-r--r--
Do not load preferences when spawning a VM ...to make tests stable and not dependent on what's in preferences.

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

"{ NameSpace: RegressionTests }"

nil subclass:#ManyProcessesTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!


!ManyProcessesTest class methodsFor:'others'!

version_CVS
    ^ '$Header$'
! !

!ManyProcessesTest methodsFor:'test'!

start:count
"
ManyProcessesTest new test400
"
    |waitSema|

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

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

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.
    Transcript showCR:'done'.
! !

!ManyProcessesTest class methodsFor:'documentation'!

version
    ^ '$Header$'
! !