--- a/reports/Builder__TestReport.st Mon Jul 02 08:46:02 2018 +0200
+++ b/reports/Builder__TestReport.st Fri Aug 24 11:23:42 2018 +0100
@@ -10,8 +10,9 @@
!
TestResult subclass:#Result
- instanceVariableNames:'format time npassed nfailed nerror nskipped collector'
- classVariableNames:'TimeoutScale'
+ instanceVariableNames:'format time timeoutScale timeoutScaleReassesmentTime npassed
+ nfailed nerror nskipped collector'
+ classVariableNames:''
poolDictionaries:''
privateIn:TestReport
!
@@ -322,6 +323,51 @@
^nskipped
"Created: / 31-01-2013 / 13:54:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+timeoutScale
+ "Return a timeout scaling factor used to adjust test-case defined timeout.
+ This is required in order to stabilize tests on different computers and setups.
+ Slower machines may need higher timeout otherwise tests may fail."
+
+ "/ This scaling factor is computed automatically by running a (not so) simple
+ "/ benchmark. To make things more complicated, we have to re-asses the scaling
+ "/ factor time to time as machine performance may vary depending on a load - this
+ "/ happens specially on CI setups where CI slaves are virtualized and running on
+ "/ heavily-loaded systems.
+ "/
+ "/ The benchmark itself consists of:
+ "/
+ "/ * CPU benchmark - to handle systems with slow CPUs such as some
+ "/ low-end Celerons on RPi-kind of thing)
+ "/ * IO benchmark - to handle the case of slow IO on overloaded host
+ "/ running many tests in parallel.
+ "/
+
+
+ (timeoutScale isNil or: [timeoutScaleReassesmentTime < OperatingSystem getMillisecondTime ]) ifTrue:[
+ | time1 files time2 scale1 scale2 |
+
+ "/ simple CPU benchmark
+ time1 := Time millisecondsToRun:[3000 timesRepeat: [ 2000 factorial ]].
+ scale1 := time1 / 2500"mean value of an i5 64bit".
+
+ files := (Smalltalk getPackageDirectoryForPackage: self class package) recursiveDirectoryContentsAsFilenames
+ select: [:e | e isRegularFile and:[e suffix = 'st']].
+ time2 := Time millisecondsToRun:[ 10 timesRepeat: [ files shuffled do:[:e|e contents ] ] ].
+ scale2 := time2 / 2500"mean value of an 64bit linux ext4 on SATA SSD".
+
+ timeoutScale := (scale1 max: scale2) max: 1.
+ timeoutScaleReassesmentTime := OperatingSystem getMillisecondTime + (1000*60*3) "/ reasses every three minutes
+ ].
+ ^ timeoutScale
+
+ "
+ Builder::TestReport::Result new timeoutScale; timeoutScale
+ "
+
+ "Created: / 24-08-2018 / 09:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 24-08-2018 / 11:20:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestReport::Result methodsFor:'adding'!
@@ -386,15 +432,10 @@
super initialize.
npassed := nfailed := nerror := nskipped := 0.
- TimeoutScale isNil ifTrue:[
- | bench |
-
- bench := Time millisecondsToRun:[3000 timesRepeat: [ 2000 factorial ]].
- TimeoutScale := (bench / 2500"mean value of an i5 32bit") max: 1.
- ].
+ timeoutScaleReassesmentTime := 0
"Created: / 31-01-2013 / 13:52:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 14-11-2016 / 23:37:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-08-2018 / 10:58:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestReport::Result methodsFor:'running'!
@@ -498,7 +539,7 @@
Logger trace: 'Running %1>>%2' with: aTestCase nameForHDTestReport with: aTestCase selectorForHDTestReport.
Transcript show:'F'.
- timeout := (timeoutBase * TimeoutScale) rounded.
+ timeout := (timeoutBase * self timeoutScale) rounded.
sema := Semaphore new.
stime := OperatingSystem getMillisecondTime.
log := false.
@@ -520,8 +561,8 @@
etime := OperatingSystem getMillisecondTime.
timeouted ifTrue:[
- error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with:TimeoutScale) .
- outcome isNil ifTrue:[ outcome := self createOutcome ].
+ error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with: timeoutScale asFloat) .
+ outcome isNil ifTrue:[ outcome := self createOutcome ].
outcome result: TestResult stateError.
format
writeTestCase: aTestCase outcome: outcome
@@ -536,14 +577,14 @@
Transcript cr.
"Created: / 12-01-2012 / 17:42:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 16-11-2016 / 23:26:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-08-2018 / 11:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
unixForkCase:aTestCase debugged: debugged timeout: timeoutBase
| timeout pid status sema stime etime error stack suiteFailuresBefore suiteErrorsBefore log logPos |
Transcript show:'forking...'.
- timeout := (timeoutBase * TimeoutScale) rounded.
+ timeout := (timeoutBase * self timeoutScale) rounded.
sema := Semaphore new.
stime := OperatingSystem getMillisecondTime.
log := false.
@@ -593,7 +634,7 @@
[ log := true.
status isNil
ifTrue:
- [ error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with:TimeoutScale) .
+ [ error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with:timeoutScale asFloat) .
stack := 'Oops, timed out!! (timeout was ' , timeout printString , ' sec)'. ]
ifFalse:
[ status status == #signal
@@ -630,7 +671,7 @@
Transcript cr.
"Created: / 12-01-2012 / 17:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 16-11-2016 / 23:26:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-08-2018 / 11:19:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestReport class methodsFor:'documentation'!