diff -r 32e722badd92 -r 67d1c7df7f90 reports/Builder__TestReport.st --- 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 " +! + +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 " + "Modified (comment): / 24-08-2018 / 11:20:15 / Jan Vrany " ! ! !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 " - "Modified: / 14-11-2016 / 23:37:40 / Jan Vrany " + "Modified: / 24-08-2018 / 10:58:55 / Jan Vrany " ! ! !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 " - "Modified: / 16-11-2016 / 23:26:07 / Jan Vrany " + "Modified: / 24-08-2018 / 11:19:24 / Jan Vrany " ! 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 " - "Modified: / 16-11-2016 / 23:26:36 / Jan Vrany " + "Modified: / 24-08-2018 / 11:19:44 / Jan Vrany " ! ! !TestReport class methodsFor:'documentation'!