reports/Builder__TestReport.st
branchjv
changeset 322 9ec2abb1218e
parent 318 b7f0437a6d18
child 324 3bd7d9ad8b3f
--- a/reports/Builder__TestReport.st	Sat May 28 10:40:05 2016 +0100
+++ b/reports/Builder__TestReport.st	Mon Nov 14 23:43:14 2016 +0000
@@ -11,7 +11,7 @@
 
 TestResult subclass:#Result
 	instanceVariableNames:'format time npassed nfailed nerror nskipped collector'
-	classVariableNames:''
+	classVariableNames:'TimeoutScale'
 	poolDictionaries:''
 	privateIn:TestReport
 !
@@ -380,9 +380,16 @@
 initialize
     super initialize.
 
-    npassed := nfailed := nerror := nskipped := 0
+    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.
+    ].
 
     "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>"
 ! !
 
 !TestReport::Result methodsFor:'running'!
@@ -481,11 +488,12 @@
 
 !TestReport::Result methodsFor:'running-private'!
 
-lightForkCase:aTestCase debugged: debugged timeout: timeout
-    | thread sema stime etime timeouted error stack log logPos |
+lightForkCase:aTestCase debugged: debugged timeout: timeoutBase
+    | timeout thread sema stime etime timeouted error stack log logPos |
 
     Logger trace: 'Running %1>>%2' with: aTestCase nameForHDTestReport with: aTestCase selectorForHDTestReport.
     Transcript show:'F'.
+    timeout := (timeoutBase * TimeoutScale) rounded. 
     sema := Semaphore new.
     stime := OperatingSystem getMillisecondTime.
     log := false.
@@ -507,7 +515,7 @@
 
     etime := OperatingSystem getMillisecondTime.
     timeouted ifTrue:[
-        error := TimeoutError new messageText: 'Timed out'.
+        error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with:TimeoutScale) .
         outcome result: TestResult stateError.
         format 
             writeTestCase: aTestCase outcome: outcome 
@@ -522,13 +530,14 @@
     Transcript cr.
 
     "Created: / 12-01-2012 / 17:42:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 29-10-2014 / 13:59:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-11-2016 / 23:26:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-unixForkCase:aTestCase debugged: debugged timeout: timeout
-    | pid status sema stime etime error stack suiteFailuresBefore suiteErrorsBefore log logPos |
+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.   
     sema := Semaphore new.
     stime := OperatingSystem getMillisecondTime.
     log := false.
@@ -578,7 +587,7 @@
                     [ log := true.
                     status isNil 
                         ifTrue:
-                            [ error := TimeoutError new parameter:timeout.
+                            [ error := TimeoutError new messageText: ('Timed out (effective %1ms, base %2ms, scale %3)' bindWith: timeout with: timeoutBase with:TimeoutScale) .
                             stack := 'Oops, timed out!! (timeout was ' , timeout printString , ' sec)'. ]
                         ifFalse:
                             [ status status == #signal 
@@ -615,7 +624,7 @@
     Transcript cr.
 
     "Created: / 12-01-2012 / 17:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 06-06-2014 / 00:54:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-11-2016 / 23:26:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !TestReport class methodsFor:'documentation'!