SUnit.st 2.8 KB

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