SUnit.st 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  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. shouldInheritSelectors
  79. ^self ~= self lookupHierarchyRoot
  80. ! !
  81. Error subclass: #TestFailure
  82. instanceVariableNames: ''
  83. package: 'SUnit'!
  84. Object subclass: #TestResult
  85. instanceVariableNames: 'timestamp runs errors failures total'
  86. package: 'SUnit'!
  87. !TestResult methodsFor: 'accessing'!
  88. addError: anError
  89. self errors add: anError
  90. !
  91. addFailure: aFailure
  92. self failures add: aFailure
  93. !
  94. errors
  95. ^errors
  96. !
  97. failures
  98. ^failures
  99. !
  100. increaseRuns
  101. runs := runs + 1
  102. !
  103. runs
  104. ^runs
  105. !
  106. status
  107. ^self errors isEmpty
  108. ifTrue: [
  109. self failures isEmpty
  110. ifTrue: ['success']
  111. ifFalse: ['failure']]
  112. ifFalse: ['error']
  113. !
  114. timestamp
  115. ^timestamp
  116. !
  117. total
  118. ^total
  119. !
  120. total: aNumber
  121. total := aNumber
  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. ! !