--- 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'!