TestCase.st
author Claus Gittinger <cg@exept.de>
Fri, 09 May 2003 19:42:33 +0200
changeset 97 1f7ff8664715
parent 95 06622db7c5a8
child 101 3eac160a3c2f
permissions -rw-r--r--
*** empty log message ***
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
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    10
TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    11
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    12
"
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    13
 No other class instance variables are inherited by this class.
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    14
"
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    15
!
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    16
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
    17
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    18
!TestCase class methodsFor:'initialization'!
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    19
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    20
initialize
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    21
    "ensure, that the sunit extensions are loaded"
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    22
65
019891d527b7 implements -> includesSelector
Claus Gittinger <cg@exept.de>
parents: 63
diff changeset
    23
    (Class includesSelector:#sunitName) ifFalse:[
019891d527b7 implements -> includesSelector
Claus Gittinger <cg@exept.de>
parents: 63
diff changeset
    24
        Smalltalk fileIn:'extensions.st' inPackage:(self package)
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    25
    ].    
72
a39bc71cdc5b Simplify autoloading
Stefan Vogel <sv@exept.de>
parents: 70
diff changeset
    26
    TestFailure autoload
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    27
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    28
    "
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    29
     self initialize
4
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    30
    "
ce83a7e08215 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3
diff changeset
    31
! !
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
    32
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
    33
!TestCase class methodsFor:'instance creation'!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
debug: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    36
	^(self selector: aSymbol) debug
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    37
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
run: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    40
	^(self selector: aSymbol) run
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    41
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
selector: aSymbol
6
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    44
	^self new setTestSelector: aSymbol
78bb1397e43d added rerun-defect tests; fixed button enable bug
Claus Gittinger <cg@exept.de>
parents: 4
diff changeset
    45
!
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
suite
92
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    48
        ^self buildSuite
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    49
"/        | testSelectors result |
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    50
"/
93
ff9039a4d7fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 92
diff changeset
    51
"/        testSelectors := self testSelectors.
92
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    52
"/        testSelectors sort.
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    53
"/        
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    54
"/        result := TestSuite new.
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    55
"/        result name:self name.
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    56
"/        testSelectors do: [:each | result addTest: (self selector: each)].
b7b33f1668db include inherited testSelectors from abstract tests in testSelectors
Claus Gittinger <cg@exept.de>
parents: 90
diff changeset
    57
"/        ^result
0
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
    "Modified: / 21.6.2000 / 10:05:24 / Sames"
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
! !
9365d5753f11 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    62
!TestCase class methodsFor:'accessing'!
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
allTestSelectors
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    65
        ^self sunitAllSelectors select: [:each | 'test*' match: each]
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    66
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
    67
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    68
forgetLastTestRunResult
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    69
    lastTestRunResultOrNil ~~ nil ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    70
        lastTestRunResultOrNil := nil.
82
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    71
        Smalltalk changed:#lastTestRunResult with:self.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    72
        self changed:#lastTestRunResult.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    73
    ]
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    74
!
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    75
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    76
lastTestRunResultOrNil
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    77
    ^ lastTestRunResultOrNil
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    78
!
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    79
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    80
rememberFailedTest:selector
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    81
    lastTestRunsFailedTests isNil ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    82
        lastTestRunsFailedTests := Set new.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    83
    ].
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    84
    lastTestRunsFailedTests add:selector.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    85
    self rememberFailedTestRun
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    86
!
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    87
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    88
rememberFailedTestRun
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    89
    lastTestRunResultOrNil ~~ false ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    90
        lastTestRunResultOrNil := false.
82
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    91
        Smalltalk changed:#lastTestRunResult with:self.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    92
        self changed:#lastTestRunResult.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
    93
    ]
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    94
!
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
    95
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    96
rememberFailedTestRunWithResult:result
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    97
    self rememberFailedTestRun.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    98
    (result failures , result errors) do:[:eachFailedTest |
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
    99
        |sel|
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   100
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   101
        sel := eachFailedTest selector.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   102
        self rememberFailedTest:sel.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   103
    ].
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   104
!
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   105
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   106
rememberPassedTest:selector
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   107
    lastTestRunsFailedTests notNil ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   108
        lastTestRunsFailedTests remove:selector ifAbsent:nil.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   109
        lastTestRunsFailedTests isEmpty ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   110
            lastTestRunsFailedTests := nil
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   111
        ]
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   112
    ].
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   113
!
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   114
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
   115
rememberPassedTestRun
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   116
    lastTestRunResultOrNil ~~ true ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   117
        lastTestRunResultOrNil := true.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   118
        lastTestRunsFailedTests := nil.
82
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
   119
        Smalltalk changed:#lastTestRunResult with:self.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
   120
        self changed:#lastTestRunResult.
e0e67a37e1ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 81
diff changeset
   121
    ]
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
   122
!
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
   123
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   124
resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   125
	^#()
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   126
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   127
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   128
testSelectorFailed:selector
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   129
    ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   130
!
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   131
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   132
testSelectors
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   133
        ^self sunitSelectors select: [:each | 'test*' match: each]
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
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   136
!TestCase class methodsFor:'building Suites'!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   137
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   138
buildSuite
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   139
95
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   140
        | suite |
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   141
        ^self isAbstract 
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   142
                ifTrue: 
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   143
                        [suite := TestSuite new.
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   144
self halt.
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   145
                        suite name: self name asString.
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   146
                        self allSubclasses do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   147
                        suite]
06622db7c5a8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 93
diff changeset
   148
                ifFalse: [self buildSuiteFromSelectors]
68
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   149
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   150
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   151
buildSuiteFromAllSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   152
	^self buildSuiteFromMethods: self allTestSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   153
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   154
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   155
buildSuiteFromLocalSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   156
	^self buildSuiteFromMethods: self testSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   157
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   158
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   159
buildSuiteFromMethods: testMethods 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   160
	^testMethods 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   161
		inject: ((TestSuite new)
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   162
				name: self name asString;
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   163
				yourself)
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   164
		into: 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   165
			[:suite :selector | 
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   166
			suite
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   167
				addTest: (self selector: selector);
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   168
				yourself]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   169
!
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   170
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   171
buildSuiteFromSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   172
	^self shouldInheritSelectors
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   173
		ifTrue: [self buildSuiteFromAllSelectors]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   174
		ifFalse: [self buildSuiteFromLocalSelectors]
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   175
! !
9fd111438d60 category renames (lower case)
Claus Gittinger <cg@exept.de>
parents: 67
diff changeset
   176
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   177
!TestCase class methodsFor:'testing'!
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   178
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   179
isAbstract
90
35bbf3487eb1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 87
diff changeset
   180
        "Override to true if a TestCase subclass is Abstract and should not have
35bbf3487eb1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 87
diff changeset
   181
        TestCase instances built from it"
35bbf3487eb1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 87
diff changeset
   182
35bbf3487eb1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 87
diff changeset
   183
        ^self name = #TestCase.
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   184
!
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   185
87
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   186
runTests
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   187
    |result|
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   188
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   189
    result := self suite run.
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   190
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   191
    result hasPassed ifTrue:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   192
        self rememberPassedTestRun
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   193
    ] ifFalse:[
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   194
        self rememberFailedTestRunWithResult:result
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   195
    ].
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   196
!
24e88e7f5d88 remember individual failed cases.
Claus Gittinger <cg@exept.de>
parents: 82
diff changeset
   197
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   198
shouldInheritSelectors
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   199
	"answer true to inherit selectors from superclasses"
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   200
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   201
	^true
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   202
! !
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   203
97
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   204
!TestCase methodsFor:'accessing & queries'!
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   205
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   206
unfinished
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   207
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   208
	"indicates an unfinished test"
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   209
! !
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   210
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   211
!TestCase methodsFor:'assertions'!
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   212
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   213
assert: aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   214
    "fail, if the argument is not true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   215
69
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   216
"/    "check the testCase itself"
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   217
"/    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   218
"/    aBoolean ifFalse: [self signalFailure: 'Assertion failed']
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   219
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   220
    self assert: aBoolean message:'Assertion failed'
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   221
!
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   222
97
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   223
assert:aBlock completesInSeconds:aNumber
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   224
    "fail, if aBlock does not finish its work in aNumber seconds"
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   225
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   226
    |done process semaphore|
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   227
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   228
    done := false.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   229
    semaphore := Semaphore new.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   230
    [
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   231
        process := Processor activeProcess.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   232
        aBlock value.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   233
        done := true.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   234
        semaphore signal
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   235
    ] fork.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   236
    semaphore waitWithTimeout: aNumber.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   237
    process terminate.
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   238
    self assert: done       
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   239
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   240
    "
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   241
     self new assert:[Delay waitForSeconds:2] completesInSeconds:1
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   242
    "
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   243
    "
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   244
     self new assert:[Delay waitForSeconds:1] completesInSeconds:2
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   245
    "
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   246
!
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   247
69
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   248
assert: aBoolean message:messageIfFailing
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   249
    "fail, if the argument is not true"
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   250
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   251
    "check the testCase itself"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   252
    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
69
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   253
    aBoolean ifFalse: [self signalFailure: messageIfFailing]
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   254
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   255
    "Modified: / 21.6.2000 / 10:00:05 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   256
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   257
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   258
assertFalse:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   259
    ^ self assert:aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   260
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   261
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   262
assertFalse:aBoolean named:testName
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   263
    ^ self assert:aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   264
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   265
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   266
assertTrue:aBoolean 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   267
    ^ self assert:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   268
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   269
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   270
assertTrue:aBoolean named:testName
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   271
    ^ self assert:aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   272
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   273
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   274
deny: aBoolean
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   275
    "fail, if the argument is not false"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   276
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   277
    self assert: aBoolean not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   278
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   279
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   280
resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   281
	^self class resources
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   282
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   283
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   284
selector
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   285
	^testSelector
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   286
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   287
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   288
should: aBlock
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   289
    "fail, if the block does not evaluate to true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   290
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   291
    self assert: aBlock value
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   292
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   293
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   294
should: aBlock raise: anExceptionalEvent 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   295
    "fail, if the block does not raise the given event"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   296
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   297
    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   298
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   299
    "Modified: / 21.6.2000 / 10:01:08 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   300
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   301
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   302
shouldnt: aBlock
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   303
    "fail, if the block does evaluate to true"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   304
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   305
    self deny: aBlock value
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   306
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   307
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   308
shouldnt: aBlock raise: anExceptionalEvent 
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   309
    "fail, if the block does raise the given event"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   310
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   311
    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   312
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   313
    "Modified: / 21.6.2000 / 10:01:16 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   314
!
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   315
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   316
signalFailure: aString
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   317
    "/ TestResult failure sunitSignalWith: aString
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   318
    TestResult failure raiseErrorString:aString in:thisContext sender sender .
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   319
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   320
    "Modified: / 21.6.2000 / 10:01:34 / Sames"
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   321
! !
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   322
67
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   323
!TestCase methodsFor:'dependencies'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   324
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   325
addDependentToHierachy: anObject 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   326
	"an empty method. for Composite compability with TestSuite"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   327
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   328
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   329
removeDependentFromHierachy: anObject 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   330
	"an empty method. for Composite compability with TestSuite"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   331
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   332
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   333
!TestCase methodsFor:'printing'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   334
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   335
name
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   336
        ^ self class name.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   337
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   338
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   339
printOn: aStream
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   340
	aStream nextPutAll: self class name.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   341
	aStream nextPutAll: '>>'.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   342
	aStream nextPutAll: testSelector
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   343
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   344
    "Modified: / 4.4.2000 / 18:59:53 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   345
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   346
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   347
!TestCase methodsFor:'private'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   348
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   349
executeShould: aBlock inScopeOf: anExceptionalEvent 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   350
	[[aBlock value]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   351
		on: anExceptionalEvent
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   352
		do: [:ex | ^true]]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   353
			on: TestResult error
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   354
			do: [:ex | ^false].
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   355
	^false.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   356
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   357
    "Modified: / 21.6.2000 / 10:03:03 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   358
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   359
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   360
performTest
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   361
        self perform: testSelector asSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   362
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   363
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   364
setTestSelector: aSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   365
	testSelector := aSymbol
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   366
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   367
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   368
!TestCase methodsFor:'running'!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   369
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   370
debug
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   371
        self debugUsing:#runCase.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   372
"/        (self class selector: testSelector) runCase
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   373
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   374
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   375
debugAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   376
        self debugUsing: #runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   377
"/        (self class selector: testSelector) runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   378
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   379
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   380
debugUsing: aSymbol 
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   381
        self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   382
        [(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
   383
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   384
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   385
openDebuggerOnFailingTestMethod
69
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   386
        "SUnit has halted one step in front of the failing test method. 
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   387
        Step over the 'self halt' and send into 'self perform: testSelector' 
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   388
        to see the failure from the beginning"
67
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   389
69
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   390
        "/ self halt.
c5bff082e12f added #assert:message:
james
parents: 68
diff changeset
   391
        self performTest "/ perform: testSelector asSymbol
67
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   392
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   393
    "Modified: / 21.6.2000 / 10:03:37 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   394
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   395
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   396
run
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   397
	| result |
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   398
	result := TestResult new.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   399
	self run: result.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   400
	^result
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   401
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   402
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   403
run: aResult
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   404
	aResult runCase: self
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   405
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   406
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   407
run: aResult afterEachDo:block2
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   408
        aResult runCase: self.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   409
        block2 value:self value:aResult.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   410
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   411
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   412
run: aResult beforeEachDo:block1 afterEachDo:block2
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   413
        block1 value:self value:aResult.
70
2ff4508f476d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 69
diff changeset
   414
"/testSelector == #testReadStatement ifTrue:[self halt].
67
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   415
        aResult runCase: self.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   416
        block2 value:self value:aResult.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   417
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   418
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   419
runCase
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   420
        self setUp.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   421
        [self performTest "self perform: testSelector asSymbol"] ensure: [self tearDown]
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   422
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   423
    "Modified: / 21.6.2000 / 10:04:18 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   424
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   425
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   426
runCaseAsFailure
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   427
        self setUp.
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   428
        [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   429
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   430
    "Modified: / 21.6.2000 / 10:04:33 / Sames"
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   431
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   432
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   433
setUp
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   434
!
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   435
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   436
tearDown
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   437
! !
7861684195ec category rename
Claus Gittinger <cg@exept.de>
parents: 66
diff changeset
   438
66
31ae5b8fc382 category rename
Claus Gittinger <cg@exept.de>
parents: 65
diff changeset
   439
!TestCase methodsFor:'testing'!
50
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   440
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   441
areAllResourcesAvailable
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   442
	^self resources 
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   443
		inject: true
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   444
		into: [:total :each | each isAvailable & total]
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   445
! !
6db52a1a4543 updgraded to 3.0
Claus Gittinger <cg@exept.de>
parents: 40
diff changeset
   446
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   447
!TestCase class methodsFor:'documentation'!
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   448
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   449
version
97
1f7ff8664715 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 95
diff changeset
   450
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.34 2003-05-09 17:42:33 cg Exp $'
12
4a6597527f92 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6
diff changeset
   451
! !
81
10852410025d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 73
diff changeset
   452
2
6f450bf08bc0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1
diff changeset
   453
TestCase initialize!