Moved error handling to command line adapter.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Thu, 01 Aug 2013 19:19:16 +0100
changeset 147 91e4feb2c8b5
parent 146 249b6f39910c
child 148 c2a799334bf8
Moved error handling to command line adapter. This makes testing a lot easier.
s/BenchmarkExecutor.st
s/BenchmarkParameter.st
s/BenchmarkRunner.st
s/BenchmarkSuite.st
s/s.rc
s/stx/BenchmarkRunnerAdapterStX.st
s/stx/stx.rc
s/tests/BenchmarkRunnerTests.st
s/tests/tests.rc
--- a/s/BenchmarkExecutor.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/BenchmarkExecutor.st	Thu Aug 01 19:19:16 2013 +0100
@@ -133,11 +133,16 @@
         ].
         aBenchmarkInstance setUp.        
     ] on: Error do:[:ex|
-        BenchmarkExecutionError new signal:'Error during set-up: ', ex description.      
+        (ex isKindOf: BenchmarkError) ifTrue:[
+            ex pass
+        ] ifFalse:[
+            BenchmarkExecutionError new signal:'Error during set-up: ', ex description.
+        ].
+
     ]
 
     "Created: / 27-07-2013 / 12:31:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 31-07-2013 / 01:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:14:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 tearDown: aBenchmarkInstance
--- a/s/BenchmarkParameter.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/BenchmarkParameter.st	Thu Aug 01 19:19:16 2013 +0100
@@ -13,11 +13,10 @@
 initialize
     "Invoked at system start or when the class is dynamically loaded."
 
-    "/ please change as required (and remove this comment)
-
     UndefinedValue := Object new.
 
     "Modified: / 30-07-2013 / 23:31:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (comment): / 01-08-2013 / 18:39:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkParameter class methodsFor:'instance creation'!
@@ -111,6 +110,19 @@
     "Created: / 27-07-2013 / 11:43:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!BenchmarkParameter methodsFor:'printing & storing'!
+
+printOn:aStream
+    "append a printed representation if the receiver to the argument, aStream"
+
+    name printOn: aStream.
+    aStream nextPutAll:' ['.
+    type printOn: aStream.
+    aStream nextPutAll:']'.
+
+    "Modified: / 01-08-2013 / 18:52:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !BenchmarkParameter class methodsFor:'documentation'!
 
 version_HG
--- a/s/BenchmarkRunner.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/BenchmarkRunner.st	Thu Aug 01 19:19:16 2013 +0100
@@ -1,7 +1,7 @@
 "{ Package: 'jv:calipel/s' }"
 
 Object subclass:#BenchmarkRunner
-	instanceVariableNames:'debugging suite result'
+	instanceVariableNames:'suite result'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'CalipeL-S-Core-Runner'
@@ -27,14 +27,6 @@
 
 !BenchmarkRunner methodsFor:'accessing'!
 
-debugging
-    ^ debugging
-!
-
-debugging:aBoolean
-    debugging := aBoolean.
-!
-
 result
     ^ result
 !
@@ -43,40 +35,6 @@
     ^ suite
 ! !
 
-!BenchmarkRunner methodsFor:'error handling'!
-
-error: message
-    debugging ifTrue:[
-        super error: message    
-    ] ifFalse:[
-        BenchmarkPlatform current stderr nextPutAll: 'ERROR: '; nextPutAll: message; nextPutAll:'
-'.
-        BenchmarkPlatform current stderr nextPutAll: '       '; nextPutAll: 'try --help to see available options'; nextPutAll:'
-'.    
-        BenchmarkPlatform current exit: 1
-    ].
-
-!
-
-exit: code
-    debugging ifFalse:[
-        BenchmarkPlatform current exit: code
-    ].
-
-    "Created: / 02-11-2012 / 02:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 06-06-2013 / 09:13:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!BenchmarkRunner methodsFor:'initialization'!
-
-initialize
-    "Invoked when a new instance is created."
-
-    debugging := BenchmarkPlatform current isHeadless not
-
-    "Modified: / 06-06-2013 / 09:24:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
 !BenchmarkRunner methodsFor:'main'!
 
 main:argv0
@@ -101,7 +59,6 @@
                 ].
                 runs := Integer readFrom: (argv at: i) onError:[
                     self error: '-n requires an integer parameter'.
-                    self exit: 1.
                 ].
                 i := i + 1.
             ].
@@ -207,20 +164,7 @@
     "Run suite"
     result := BenchmarkResult new.
     result runs: runs.
-    [
-        suite run: result with: params executor: BenchmarkRunnerExecutor new.
-    ] on: BenchmarkError do:[:ex|
-        debugging ifTrue:[
-            Smalltalk isSmalltalkX ifTrue:[
-                ex suspendedContext fullPrintAllOn: BenchmarkPlatform current stdout  
-            ] ifFalse:[
-                ex signallerContext printDebugOn: BenchmarkPlatform current stdout
-            ].
-            self error: 'Error when running benchmark'.
-        ] ifFalse:[
-            ex proceed.
-        ]
-    ].
+    suite run: result with: params executor: BenchmarkRunnerExecutor new.
 
     "Write report"
     file notNil ifTrue:[
@@ -235,9 +179,7 @@
             write: result on: BenchmarkPlatform current stdout
     ].
 
-    self exit: 0.
-
-    "Modified: / 31-07-2013 / 01:12:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 18:50:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 options
--- a/s/BenchmarkSuite.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/BenchmarkSuite.st	Thu Aug 01 19:19:16 2013 +0100
@@ -90,16 +90,12 @@
 
 run: aBenchmarkResult with: aDictionary executor: aBenchmarkExecutor
     benchmarks do:[:each|
-        [
-            each run: aBenchmarkResult with: aDictionary executor: aBenchmarkExecutor
-        ] on: BenchmarkExecutionError do:[:ex|
-            ex class new signal: ex messageText
-        ]
+        each run: aBenchmarkResult with: aDictionary executor: aBenchmarkExecutor
     ].
     ^aBenchmarkResult
 
     "Created: / 26-07-2013 / 00:07:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 31-07-2013 / 01:28:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:09:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkSuite class methodsFor:'documentation'!
--- a/s/s.rc	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/s.rc	Thu Aug 01 19:19:16 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "LibraryName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Wed, 31 Jul 2013 01:35:00 GMT\0"
+      VALUE "ProductDate", "Thu, 01 Aug 2013 18:17:39 GMT\0"
     END
 
   END
--- a/s/stx/BenchmarkRunnerAdapterStX.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/stx/BenchmarkRunnerAdapterStX.st	Thu Aug 01 19:19:16 2013 +0100
@@ -7,7 +7,7 @@
 	category:'CalipeL-S-Smalltalk/X'
 !
 
-BenchmarkRunnerAdapterStX class instanceVariableNames:'runner'
+BenchmarkRunnerAdapterStX class instanceVariableNames:'debugging'
 
 "
  The following class instance variables are inherited by this class:
@@ -27,9 +27,8 @@
     self setupSignalHandlers.
     "Make sure platform is initialized"
     BenchmarkPlatformStX initialize.
-    runner := BenchmarkRunner new.
 
-    "Modified: / 13-07-2013 / 15:05:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 18:42:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkRunnerAdapterStX class methodsFor:'debugging'!
@@ -92,20 +91,6 @@
     "Created: / 21-07-2011 / 09:48:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!BenchmarkRunnerAdapterStX class methodsFor:'error handling'!
-
-error: message
-    ^ runner error: message
-
-    "Created: / 06-06-2013 / 11:22:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-exit: status
-    ^ runner exit: status
-
-    "Created: / 06-06-2013 / 11:23:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
 !BenchmarkRunnerAdapterStX class methodsFor:'multiple applications support'!
 
 applicationRegistryPath
@@ -182,10 +167,10 @@
 setupToolsForDebug
 
     super setupToolsForDebug.
-    runner debugging: true
+    debugging := Transcript isNil or:[Transcript isView not].
 
     "Created: / 06-11-2011 / 22:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 06-06-2013 / 09:25:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 18:42:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 usage
@@ -205,11 +190,11 @@
     Stderr nextPutLine: '  --callgrind ............ run benchmark under callgrind profiler.'.
     
     Stderr cr.
-    runner options.
-    runner exit: 0.
+    BenchmarkRunner new options.
+    Smalltalk exit: 0.
 
     "Created: / 13-01-2012 / 11:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 06-06-2013 / 11:09:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:17:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkRunnerAdapterStX class methodsFor:'startup-to be redefined'!
@@ -217,38 +202,56 @@
 main:argv0
     | argv i packages |    
 
-    packages := OrderedCollection new.
-    argv := argv0 asOrderedCollection.
-    i := 1.
-    [ i <= argv size ] whileTrue:[
-        | arg |
+    [
+        packages := OrderedCollection new.
+        argv := argv0 asOrderedCollection.
+        i := 1.
+        [ i <= argv size ] whileTrue:[
+            | arg |
 
-        arg := argv at: i.
-        arg = '-p' ifTrue:[
-            i == argv size ifTrue:[
-                self error: '-p expects package name'.
-            ] ifFalse:[
-                packages add: (argv at: i + 1).
-                argv removeIndex: i; removeIndex: i.
-                i := i - 1.
+            arg := argv at: i.
+            arg = '-p' ifTrue:[
+                i == argv size ifTrue:[
+                    self error: '-p expects package name'.
+                ] ifFalse:[
+                    packages add: (argv at: i + 1).
+                    argv removeIndex: i; removeIndex: i.
+                    i := i - 1.
+                ]
+            ].
+            i := i + 1.
+        ].
+
+        "/Load packages..."
+        packages isEmpty ifTrue:[packages add: (BenchmarkInstance package , '/benchmarks')].
+        packages do:[:each|
+            (Smalltalk loadPackage: each) ifFalse:[
+                self error: 'Failed to load package ''', each ,''''.
             ]
         ].
-        i := i + 1.
-    ].
+
+        BenchmarkRunner new main: argv
 
-    "/Load packages..."
-    packages isEmpty ifTrue:[packages add: (BenchmarkInstance package , '/benchmarks')].
-    packages do:[:each|
-        (Smalltalk loadPackage: each) ifFalse:[
-            self error: 'Failed to load package ''', each ,''''.
-            self exit: 2.
-        ]
+    ] on: Error do:[:ex|
+        debugging ifTrue:[
+            Display isNil ifTrue:[
+                Smalltalk openDisplay.
+            ]. 
+            ex pass.
+        ] ifFalse:[
+            Stderr 
+                nextPutAll: 'ERROR: ';
+                nextPutAll: ex class printString;
+                nextPutAll: ': ';
+                nextPutAll: ex description;
+                cr.
+            Smalltalk exit: 1.
+        ].
     ].
-
-    runner main: argv
+    Smalltalk exit: 0.
 
     "Created: / 06-06-2013 / 10:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 11-06-2013 / 22:47:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 18:48:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkRunnerAdapterStX class methodsFor:'documentation'!
--- a/s/stx/stx.rc	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/stx/stx.rc	Thu Aug 01 19:19:16 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Sat, 22 Jun 2013 22:17:01 GMT\0"
+      VALUE "ProductDate", "Thu, 01 Aug 2013 18:17:30 GMT\0"
     END
 
   END
--- a/s/tests/BenchmarkRunnerTests.st	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/tests/BenchmarkRunnerTests.st	Thu Aug 01 19:19:16 2013 +0100
@@ -56,12 +56,12 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: #('BenchmarkTestsSuiteA').
 
     self assert: runner result outcomes size = 2.
 
     "Created: / 19-07-2013 / 21:48:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:10:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_01b
@@ -69,7 +69,6 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: #('BenchmarkTestsSuiteA#benchmark2').
 
     self assert: runner result outcomes size = 1.
@@ -77,6 +76,7 @@
     self assert: runner result outcomes anElement times first >= 200.
 
     "Created: / 19-07-2013 / 21:49:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:10:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_01c
@@ -84,7 +84,6 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: #('-Dmsecs=10' 'BenchmarkTestsSuiteA#benchmark2').
 
     self assert: runner result outcomes size = 1.
@@ -92,6 +91,7 @@
     self assert: runner result outcomes anElement times first < 200.
 
     "Created: / 19-07-2013 / 21:49:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_01d
@@ -99,7 +99,6 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: #('-n' '1' '-Dmsecs=10' 'BenchmarkTestsSuiteA#benchmark2').
 
     self assert: runner result outcomes size = 1.
@@ -107,6 +106,7 @@
     self assert: runner result outcomes anElement times first < 200.
 
     "Created: / 19-07-2013 / 21:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:09:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_01e
@@ -114,17 +114,19 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: #('-n' '1' '-Dmsecs=10,250' 'BenchmarkTestsSuiteA#benchmark2').
 
+
+
     self assert: runner result outcomes size = 2.
     self assert: runner result outcomes first times size = 1.
-    self assert: runner result outcomes first times first < 200.
+    self assert: runner result outcomes first times first >= runner result outcomes first parameters first value.
 
     self assert: runner result outcomes second times size = 1.
-    self assert: runner result outcomes second times first > 200.
+    self assert: runner result outcomes second times first >= runner result outcomes second parameters first value.
 
     "Created: / 31-07-2013 / 00:06:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:16:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_02a
@@ -141,11 +143,10 @@
         s nextPutLine: 'BenchmarkTestsSuiteA#benchmark2'.
     ].
     runner := BenchmarkRunner new.
-    runner debugging: true.
     runner main: (Array with:'--arguments' with: file pathName).
 
     self assert: runner result outcomes size = 1.
-    self assert: runner result outcomes anElement times size = 1.
+    self assert: runner result outcomes anElement times size = 5.
     self assert: runner result outcomes anElement times first < 200.
 
     ] ensure:[
@@ -153,6 +154,7 @@
     ].
 
     "Created: / 31-07-2013 / 00:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:14:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 test_basic_03a
@@ -160,11 +162,11 @@
     | runner |
 
     runner := BenchmarkRunner new.
-    runner debugging: false.
-    runner main: #('BenchmarkTestsSuiteC').
-
-    self assert: runner result outcomes isEmpty.
+    self should:[
+        runner main: #('BenchmarkTestsSuiteC').
+    ] raise: BenchmarkExecutionError
 
     "Created: / 31-07-2013 / 01:15:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-08-2013 / 19:10:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/s/tests/tests.rc	Thu Aug 01 18:25:35 2013 +0100
+++ b/s/tests/tests.rc	Thu Aug 01 19:19:16 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Wed, 31 Jul 2013 01:31:56 GMT\0"
+      VALUE "ProductDate", "Thu, 01 Aug 2013 18:16:50 GMT\0"
     END
 
   END