|
@@ -0,0 +1,37 @@
|
|
|
+Smalltalk createPackage: 'NodeTestRunner'!
|
|
|
+Object subclass: #NodeTestRunner
|
|
|
+ instanceVariableNames: ''
|
|
|
+ package: 'NodeTestRunner'!
|
|
|
+
|
|
|
+!NodeTestRunner class methodsFor: 'not yet classified'!
|
|
|
+
|
|
|
+main
|
|
|
+ self runTestSuite
|
|
|
+!
|
|
|
+
|
|
|
+runTestSuite
|
|
|
+ | suite worker |
|
|
|
+
|
|
|
+ suite := OrderedCollection new.
|
|
|
+ (TestCase allSubclasses select: [ :each | each isAbstract not ])
|
|
|
+ do: [ :each | suite addAll: each buildSuite ].
|
|
|
+
|
|
|
+ worker := TestSuiteRunner on: suite.
|
|
|
+ worker announcer on: ResultAnnouncement do:
|
|
|
+ [ :ann | | result |
|
|
|
+ result := ann result.
|
|
|
+ result runs = result total ifTrue: [
|
|
|
+ console log: result runs asString, ' tests run, ', result failures size asString, ' failures, ', result errors size asString, ' errors.'.
|
|
|
+
|
|
|
+ result failures isEmpty ifFalse: [
|
|
|
+ result failures first runCase.
|
|
|
+ "the line above should throw, normally, but just in case I leave the line below"
|
|
|
+ self throw: result failures first class name, ' >> ', result failures first selector, ' is failing!!' ].
|
|
|
+ result errors isEmpty ifFalse: [
|
|
|
+ result errors first runCase.
|
|
|
+ "the line above should throw, normally, but just in case I leave the line below"
|
|
|
+ self throw: result errors first class name, ' >> ', result errors first selector, ' has errors!!' ].
|
|
|
+ ]].
|
|
|
+ worker run
|
|
|
+! !
|
|
|
+
|