SUnit.st 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  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. !TestCase class methodsFor: 'accessing'!
  56. allTestSelectors
  57. | selectors |
  58. selectors := self testSelectors.
  59. self shouldInheritSelectors ifTrue: [
  60. selectors addAll: self superclass allTestSelectors].
  61. ^selectors
  62. !
  63. buildSuite
  64. ^self allTestSelectors collect: [:each | self selector: each]
  65. !
  66. lookupHierarchyRoot
  67. ^TestCase
  68. !
  69. selector: aSelector
  70. ^self new
  71. setTestSelector: aSelector;
  72. yourself
  73. !
  74. testSelectors
  75. ^self methodDictionary keys select: [:each | each match: '^test']
  76. ! !
  77. !TestCase class methodsFor: 'testing'!
  78. isAbstract
  79. ^ self name = 'TestCase'
  80. !
  81. shouldInheritSelectors
  82. ^self ~= self lookupHierarchyRoot
  83. ! !
  84. Error subclass: #TestFailure
  85. instanceVariableNames: ''
  86. package: 'SUnit'!
  87. Object subclass: #TestResult
  88. instanceVariableNames: 'timestamp runs errors failures total'
  89. package: 'SUnit'!
  90. !TestResult methodsFor: 'accessing'!
  91. addError: anError
  92. self errors add: anError
  93. !
  94. addFailure: aFailure
  95. self failures add: aFailure
  96. !
  97. errors
  98. ^errors
  99. !
  100. failures
  101. ^failures
  102. !
  103. increaseRuns
  104. runs := runs + 1
  105. !
  106. runs
  107. ^runs
  108. !
  109. status
  110. ^self errors isEmpty
  111. ifTrue: [
  112. self failures isEmpty
  113. ifTrue: ['success']
  114. ifFalse: ['failure']]
  115. ifFalse: ['error']
  116. !
  117. timestamp
  118. ^timestamp
  119. !
  120. total
  121. ^total
  122. !
  123. total: aNumber
  124. total := aNumber
  125. ! !
  126. !TestResult methodsFor: 'initialization'!
  127. initialize
  128. super initialize.
  129. timestamp := Date now.
  130. runs := 0.
  131. errors := Array new.
  132. failures := Array new.
  133. total := 0
  134. ! !