TestCase.st
author Claus Gittinger <cg@exept.de>
Tue, 26 Feb 2002 11:30:47 +0100
changeset 68 9fd111438d60
parent 67 7861684195ec
child 69 c5bff082e12f
permissions -rw-r--r--
category renames (lower case)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/sunit' }"
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Object subclass:#TestCase
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'testSelector'
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
     7
	category:'SUnit-Base'
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
    10
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    11
!TestCase class methodsFor:'initialization'!
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    12
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    13
initialize
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    14
    "ensure, that the sunit extensions are loaded"
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    15
65
019891d527b7 implements -> includesSelector
Claus Gittinger <cg@exept.de>
parents: 63
diff changeset
    16
    (Class includesSelector:#sunitName) ifFalse:[
019891d527b7 implements -> includesSelector
Claus Gittinger <cg@exept.de>
parents: 63
diff changeset
    17
        Smalltalk fileIn:'extensions.st' inPackage:(self package)
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    18
    ].    
4
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    19
    TestFailure isLoaded ifFalse:[
65
019891d527b7 implements -> includesSelector
Claus Gittinger <cg@exept.de>
parents: 63
diff changeset
    20
        TestFailure autoload
4
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    21
    ].
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    22
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    23
    "
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    24
     self initialize
4
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    25
    "
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    26
! !
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    27
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    28
!TestCase class methodsFor:'instance creation'!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
debug: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    31
	^(self selector: aSymbol) debug
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    32
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
run: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    35
	^(self selector: aSymbol) run
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    36
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
selector: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    39
	^self new setTestSelector: aSymbol
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    40
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
suite
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
    43
"/        ^self buildSuite
37
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    44
        | testSelectors result |
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    45
        testSelectors := self sunitSelectors select: [:each | 'test*' match: each].
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    46
        testSelectors sort.
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    47
        result := TestSuite new.
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    48
        result name:self name.
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    49
        testSelectors do: [:each | result addTest: (self selector: each)].
6da5b7e8e3ab better update (name)
Claus Gittinger <cg@exept.de>
parents: 36
diff changeset
    50
        ^result
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    "Modified: / 21.6.2000 / 10:05:24 / Sames"
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
! !
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    55
!TestCase class methodsFor:'accessing'!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    56
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    57
allTestSelectors
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    58
        ^self sunitAllSelectors select: [:each | 'test*' match: each]
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    59
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    60
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    61
resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    62
	^#()
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    63
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    64
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    65
testSelectors
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    66
        ^self sunitSelectors select: [:each | 'test*' match: each]
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    67
! !
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    68
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    69
!TestCase class methodsFor:'building Suites'!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    70
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    71
buildSuite
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    72
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    73
	| suite |
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    74
	^self isAbstract 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    75
		ifTrue: 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    76
			[suite := TestSuite new.
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    77
			suite name: self name asString.
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    78
			self allSubclasses do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    79
			suite]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    80
		ifFalse: [self buildSuiteFromSelectors]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    81
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    82
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    83
buildSuiteFromAllSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    84
	^self buildSuiteFromMethods: self allTestSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    85
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    86
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    87
buildSuiteFromLocalSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    88
	^self buildSuiteFromMethods: self testSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    89
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    90
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    91
buildSuiteFromMethods: testMethods 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    92
	^testMethods 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    93
		inject: ((TestSuite new)
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    94
				name: self name asString;
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    95
				yourself)
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    96
		into: 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    97
			[:suite :selector | 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    98
			suite
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    99
				addTest: (self selector: selector);
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   100
				yourself]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   101
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   102
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   103
buildSuiteFromSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   104
	^self shouldInheritSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   105
		ifTrue: [self buildSuiteFromAllSelectors]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   106
		ifFalse: [self buildSuiteFromLocalSelectors]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   107
! !
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   108
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   109
!TestCase class methodsFor:'testing'!
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   110
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   111
isAbstract
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   112
	"Override to true if a TestCase subclass is Abstract and should not have
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   113
	TestCase instances built from it"
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   114
	^self name = #TestCase.
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   115
!
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   116
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   117
shouldInheritSelectors
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   118
	"answer true to inherit selectors from superclasses"
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   119
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   120
	^true
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   121
! !
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   122
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   123
!TestCase methodsFor:'accessing'!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   124
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   125
assert: aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   126
    "fail, if the argument is not true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   127
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   128
    "check the testCase itself"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   129
    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   130
    aBoolean ifFalse: [self signalFailure: 'Assertion failed']
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   131
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   132
    "Modified: / 21.6.2000 / 10:00:05 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   133
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   134
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   135
assertFalse:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   136
    ^ self assert:aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   137
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   138
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   139
assertFalse:aBoolean named:testName
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   140
    ^ self assert:aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   141
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   142
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   143
assertTrue:aBoolean 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   144
    ^ self assert:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   145
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   146
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   147
assertTrue:aBoolean named:testName
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   148
    ^ self assert:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   149
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   150
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   151
deny: aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   152
    "fail, if the argument is not false"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   153
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   154
    self assert: aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   155
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   156
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   157
resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   158
	^self class resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   159
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   160
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   161
selector
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   162
	^testSelector
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   163
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   164
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   165
should: aBlock
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   166
    "fail, if the block does not evaluate to true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   167
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   168
    self assert: aBlock value
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   169
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   170
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   171
should: aBlock raise: anExceptionalEvent 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   172
    "fail, if the block does not raise the given event"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   173
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   174
    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   175
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   176
    "Modified: / 21.6.2000 / 10:01:08 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   177
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   178
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   179
shouldnt: aBlock
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   180
    "fail, if the block does evaluate to true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   181
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   182
    self deny: aBlock value
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   183
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   184
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   185
shouldnt: aBlock raise: anExceptionalEvent 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   186
    "fail, if the block does raise the given event"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   187
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   188
    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   189
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   190
    "Modified: / 21.6.2000 / 10:01:16 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   191
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   192
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   193
signalFailure: aString
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   194
    "/ TestResult failure sunitSignalWith: aString
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   195
    TestResult failure raiseErrorString:aString in:thisContext sender sender .
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   196
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   197
    "Modified: / 21.6.2000 / 10:01:34 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   198
! !
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   199
67
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   200
!TestCase methodsFor:'dependencies'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   201
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   202
addDependentToHierachy: anObject 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   203
	"an empty method. for Composite compability with TestSuite"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   204
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   205
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   206
removeDependentFromHierachy: anObject 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   207
	"an empty method. for Composite compability with TestSuite"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   208
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   209
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   210
!TestCase methodsFor:'printing'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   211
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   212
name
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   213
        ^ self class name.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   214
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   215
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   216
printOn: aStream
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   217
	aStream nextPutAll: self class name.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   218
	aStream nextPutAll: '>>'.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   219
	aStream nextPutAll: testSelector
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   220
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   221
    "Modified: / 4.4.2000 / 18:59:53 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   222
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   223
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   224
!TestCase methodsFor:'private'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   225
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   226
executeShould: aBlock inScopeOf: anExceptionalEvent 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   227
	[[aBlock value]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   228
		on: anExceptionalEvent
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   229
		do: [:ex | ^true]]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   230
			on: TestResult error
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   231
			do: [:ex | ^false].
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   232
	^false.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   233
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   234
    "Modified: / 21.6.2000 / 10:03:03 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   235
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   236
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   237
performTest
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   238
        self perform: testSelector asSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   239
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   240
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   241
setTestSelector: aSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   242
	testSelector := aSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   243
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   244
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   245
!TestCase methodsFor:'running'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   246
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   247
debug
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   248
        self debugUsing:#runCase.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   249
"/        (self class selector: testSelector) runCase
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   250
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   251
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   252
debugAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   253
        self debugUsing: #runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   254
"/        (self class selector: testSelector) runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   255
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   256
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   257
debugUsing: aSymbol 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   258
        self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   259
        [(self class selector: testSelector) perform: aSymbol] ensure: [self resources do: [:each | each reset]]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   260
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   261
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   262
openDebuggerOnFailingTestMethod
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   263
	"SUnit has halted one step in front of the failing test method. 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   264
	Step over the 'self halt' and send into 'self perform: testSelector' 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   265
	to see the failure from the beginning"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   266
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   267
	"/ self halt.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   268
	self perform: testSelector asSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   269
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   270
    "Modified: / 21.6.2000 / 10:03:37 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   271
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   272
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   273
run
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   274
	| result |
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   275
	result := TestResult new.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   276
	self run: result.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   277
	^result
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   278
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   279
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   280
run: aResult
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   281
	aResult runCase: self
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   282
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   283
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   284
run: aResult afterEachDo:block2
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   285
        aResult runCase: self.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   286
        block2 value:self value:aResult.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   287
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   288
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   289
run: aResult beforeEachDo:block1 afterEachDo:block2
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   290
        block1 value:self value:aResult.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   291
        aResult runCase: self.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   292
        block2 value:self value:aResult.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   293
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   294
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   295
runCase
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   296
        self setUp.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   297
        [self performTest "self perform: testSelector asSymbol"] ensure: [self tearDown]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   298
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   299
    "Modified: / 21.6.2000 / 10:04:18 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   300
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   301
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   302
runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   303
        self setUp.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   304
        [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   305
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   306
    "Modified: / 21.6.2000 / 10:04:33 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   307
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   308
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   309
setUp
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   310
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   311
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   312
tearDown
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   313
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   314
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   315
!TestCase methodsFor:'testing'!
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   316
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   317
areAllResourcesAvailable
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   318
	^self resources 
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   319
		inject: true
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   320
		into: [:total :each | each isAvailable & total]
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   321
! !
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   322
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   323
!TestCase class methodsFor:'documentation'!
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   324
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   325
version
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   326
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.22 2002-02-26 10:30:20 cg Exp $'
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   327
! !
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
   328
TestCase initialize!