2
0

SUnit.st 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. Smalltalk current createPackage: 'SUnit' properties: #{}!
  2. Object subclass: #TestCase
  3. instanceVariableNames: 'testSelector'
  4. category: 'SUnit'!
  5. !TestCase methodsFor: 'accessing'!
  6. setTestSelector: aSelector
  7. testSelector := aSelector
  8. !
  9. selector
  10. ^testSelector
  11. ! !
  12. !TestCase methodsFor: 'private'!
  13. signalFailure: aString
  14. TestFailure new
  15. messageText: aString;
  16. signal
  17. ! !
  18. !TestCase methodsFor: 'running'!
  19. setUp
  20. !
  21. tearDown
  22. !
  23. runCaseFor: aTestResult
  24. self setUp.
  25. aTestResult increaseRuns.
  26. self performTestFor: aTestResult.
  27. self tearDown
  28. !
  29. performTestFor: aResult
  30. [[self perform: self selector]
  31. on: TestFailure do: [:ex | aResult addFailure: self]]
  32. on: Error do: [:ex | aResult addError: self]
  33. ! !
  34. !TestCase methodsFor: 'testing'!
  35. assert: aBoolean
  36. self assert: aBoolean description: 'Assertion failed'
  37. !
  38. deny: aBoolean
  39. self assert: aBoolean not
  40. !
  41. assert: expected equals: actual
  42. ^ self assert: (expected = actual) description: 'Expected: ', expected asString, ' but was: ', actual asString
  43. !
  44. assert: aBoolean description: aString
  45. aBoolean ifFalse: [self signalFailure: aString]
  46. !
  47. should: aBlock
  48. self assert: aBlock value
  49. !
  50. should: aBlock raise: anExceptionClass
  51. self assert: ([aBlock value. false]
  52. on: anExceptionClass
  53. do: [:ex | true])
  54. ! !
  55. !TestCase class methodsFor: 'accessing'!
  56. testSelectors
  57. ^self methodDictionary keys select: [:each | each match: '^test']
  58. !
  59. selector: aSelector
  60. ^self new
  61. setTestSelector: aSelector;
  62. yourself
  63. !
  64. lookupHierarchyRoot
  65. ^TestCase
  66. !
  67. allTestSelectors
  68. | selectors |
  69. selectors := self testSelectors.
  70. self shouldInheritSelectors ifTrue: [
  71. selectors addAll: self superclass allTestSelectors].
  72. ^selectors
  73. !
  74. buildSuite
  75. ^self allTestSelectors collect: [:each | self selector: each]
  76. ! !
  77. !TestCase class methodsFor: 'testing'!
  78. shouldInheritSelectors
  79. ^self ~= self lookupHierarchyRoot
  80. ! !
  81. Error subclass: #TestFailure
  82. instanceVariableNames: ''
  83. category: 'SUnit'!
  84. Object subclass: #TestResult
  85. instanceVariableNames: 'timestamp runs errors failures total'
  86. category: 'SUnit'!
  87. !TestResult methodsFor: 'accessing'!
  88. timestamp
  89. ^timestamp
  90. !
  91. errors
  92. ^errors
  93. !
  94. failures
  95. ^failures
  96. !
  97. total
  98. ^total
  99. !
  100. total: aNumber
  101. total := aNumber
  102. !
  103. addError: anError
  104. self errors add: anError
  105. !
  106. addFailure: aFailure
  107. self failures add: aFailure
  108. !
  109. runs
  110. ^runs
  111. !
  112. increaseRuns
  113. runs := runs + 1
  114. !
  115. status
  116. ^self errors isEmpty
  117. ifTrue: [
  118. self failures isEmpty
  119. ifTrue: ['success']
  120. ifFalse: ['failure']]
  121. ifFalse: ['error']
  122. ! !
  123. !TestResult methodsFor: 'initialization'!
  124. initialize
  125. super initialize.
  126. timestamp := Date now.
  127. runs := 0.
  128. errors := Array new.
  129. failures := Array new.
  130. total := 0
  131. ! !