Test.st 1.3 KB

12345678910111213141516171819202122232425262728293031323334353637
  1. Smalltalk current createPackage: 'Test'!
  2. Object subclass: #NodeTestRunner
  3. instanceVariableNames: ''
  4. package: 'Test'!
  5. !NodeTestRunner class methodsFor: 'not yet classified'!
  6. main
  7. self runTestSuite
  8. !
  9. runTestSuite
  10. | suite worker |
  11. suite := OrderedCollection new.
  12. (TestCase allSubclasses select: [ :each | each isAbstract not ])
  13. do: [ :each | suite addAll: each buildSuite ].
  14. worker := TestSuiteRunner on: suite.
  15. worker announcer on: ResultAnnouncement do:
  16. [ :ann | | result |
  17. result := ann result.
  18. result runs = result total ifTrue: [
  19. console log: result runs asString, ' tests run, ', result failures size asString, ' failures, ', result errors size asString, ' errors.'.
  20. result failures isEmpty ifFalse: [
  21. result failures first runCase.
  22. "the line above should throw, normally, but just in case I leave the line below"
  23. self throw: result failures first class name, ' >> ', result failures first selector, ' is failing!!' ].
  24. result errors isEmpty ifFalse: [
  25. result errors first runCase.
  26. "the line above should throw, normally, but just in case I leave the line below"
  27. self throw: result errors first class name, ' >> ', result errors first selector, ' has errors!!' ].
  28. ]].
  29. worker run
  30. ! !