--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CircularTestResourceTestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,52 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+ManyTestResourceTestCase subclass:#CircularTestResourceTestCase
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!CircularTestResourceTestCase class methodsFor:'accessing'!
+
+resources
+ ^super resources, (Array with: SimpleTestResourceCircular)
+! !
+
+!CircularTestResourceTestCase methodsFor:'running'!
+
+testTearDownOrder
+ SimpleTestResourceCircular preventAvailabilityDuring:
+ [self should: [SimpleTestResourceCircular reset; isAvailable] raise: TestResult failure.
+ self assert: SimpleTestResourceCircular rawCurrentForTest == false
+ description: 'Circular resource not in failed setUp state'.
+ self assert: SimpleTestResourceCircular1 rawCurrentForTest == false
+ description: 'Circular resource not in failed setUp state'.
+ super testTearDownOrder.
+ self assert: SimpleTestResourceCircular1 rawCurrentForTest == nil
+ description: 'Circular resource not in failed setUp state'.
+ self assert: SimpleTestResourceCircular rawCurrentForTest == nil
+ description: 'Circular resource not reset after pre-tearDown iteration'].
+! !
+
+!CircularTestResourceTestCase methodsFor:'utility'!
+
+clearOuterResourceStateDuring: aBlock
+ "To let the test run at all, we only make it circular when the preventAvailability instvar is set."
+
+ ^super clearOuterResourceStateDuring:
+ [SimpleTestResourceCircular reset.
+ self deny: SimpleTestResourceCircular1 isAlreadyAvailable
+ description: 'SimpleTestResourceCircular1 should never be available'.
+ SimpleTestResourceCircular preventAvailabilityDuring:
+ [self should: aBlock raise: TestResult failure].
+ self deny: SimpleTestResourceCircular isAlreadyAvailable
+ description: 'SimpleTestResourceCircular was set up despite having circularity set'].
+! !
+
+!CircularTestResourceTestCase class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: CircularTestResourceTestCase.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- a/ExampleSetTest.st Wed Jun 29 20:38:32 2011 +0200
+++ b/ExampleSetTest.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,13 +7,6 @@
category:'SUnit-Tests'
!
-!ExampleSetTest class methodsFor:'documentation'!
-
-description
- ^ 'An example test
-Tests some operations on Sets.
-None should fail.'
-! !
!ExampleSetTest methodsFor:'running'!
@@ -35,11 +28,11 @@
!
testIllegal
- self
- should: [empty at: 5]
+ self
+ should: [empty at: 5]
raise: TestResult error.
- self
- should: [empty at: 5 put: #abc]
+ self
+ should: [empty at: 5 put: #abc]
raise: TestResult error
!
@@ -63,6 +56,6 @@
!ExampleSetTest class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/ExampleSetTest.st,v 1.6 2002-02-26 10:30:22 cg Exp $'
+version_SVN
+ ^ '§Id: ExampleSetTest.st 214 2011-03-14 12:22:21Z vranyj1 §'
! !
--- a/ExampleTestResource.st Wed Jun 29 20:38:32 2011 +0200
+++ b/ExampleTestResource.st Wed Jun 29 21:15:49 2011 +0200
@@ -42,7 +42,7 @@
!ExampleTestResource methodsFor:'running'!
setUp
-
+
self runningState: self startedStateSymbol
!
@@ -54,22 +54,26 @@
!ExampleTestResource methodsFor:'testing'!
isAvailable
-
+
^self runningState == self startedStateSymbol
!
isStarted
-
+
^self runningState == self startedStateSymbol
!
isStopped
-
+
^self runningState == self stoppedStateSymbol
! !
!ExampleTestResource class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/ExampleTestResource.st,v 1.2 2002-02-26 10:30:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/ExampleTestResource.st,v 1.3 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: ExampleTestResource.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/FailingTestResourceTestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,25 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResourceTestCase subclass:#FailingTestResourceTestCase
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!FailingTestResourceTestCase methodsFor:'utility'!
+
+clearOuterResourceStateDuring: aBlock
+ "Make the resource impossible to make available, then ensure that every test raises a failure but not an error (which its setUp would do if it reached it and the resource were nil)."
+
+ ^super clearOuterResourceStateDuring:
+ [SimpleTestResource preventAvailabilityDuring:
+ [self should: aBlock raise: TestResult failure]]
+! !
+
+!FailingTestResourceTestCase class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: FailingTestResourceTestCase.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- a/Make.proto Wed Jun 29 20:38:32 2011 +0200
+++ b/Make.proto Wed Jun 29 21:15:49 2011 +0200
@@ -1,6 +1,6 @@
-# $Header: /cvs/stx/stx/goodies/sunit/Make.proto,v 1.6 2008-10-31 12:49:05 cg Exp $
+# $Header: /cvs/stx/stx/goodies/sunit/Make.proto,v 1.7 2011-06-29 19:15:49 cg Exp $
#
-# DO NOT EDIT
+# DO NOT EDIT
# automagically generated from the projectDefinition: stx_goodies_sunit.
#
# Warning: once you modify this file, do not rerun
@@ -30,15 +30,15 @@
REQUIRED_SUPPORT_DIRS=
-# if your embedded C code requires any system includes,
-# add the path(es) here:,
+# if your embedded C code requires any system includes,
+# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libview2 -I$(INCLUDE_TOP)/stx/libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libview -I$(INCLUDE_TOP)/stx/libview2 -I$(INCLUDE_TOP)/stx/libbasic
-# if you need any additional defines for embedded C code,
-# add them here:,
+# if you need any additional defines for embedded C code,
+# add them here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
LOCALDEFINES=
@@ -63,8 +63,14 @@
all:: preMake classLibRule postMake
-pre_objs::
+pre_objs:: update-svn-revision
+
+
+update-svn-revision:
+ sed -i -e "s/\"\$$SVN\-Revision:\".*\"\$$\"/\"\$$SVN-Revision:\"'$(shell svnversion -n)'\"\$$\"/g" \
+ stx_goodies_sunit.st
+.PHONY: update-svn-revision
# add more install actions here
@@ -80,17 +86,11 @@
postMake:: cleanjunk
prereq: $(REQUIRED_SUPPORT_DIRS)
- (cd ../../libbasic ; $(MAKE))
- (cd ../../libbasic2 ; $(MAKE))
- (cd ../../libcomp ; $(MAKE))
- (cd ../../libview ; $(MAKE))
- (cd ../../libbasic3 ; $(MAKE))
- (cd ../../libview2 ; $(MAKE))
- (cd ../../libui ; $(MAKE))
- (cd ../../libwidg ; $(MAKE))
- (cd ../../libwidg2 ; $(MAKE))
- (cd ../../libtool ; $(MAKE))
- (cd ../../librun ; $(MAKE))
+ cd ../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../../librun && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -106,16 +106,17 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
$(OUTDIR)SUnitDelay.$(O) SUnitDelay.$(H): SUnitDelay.st $(INCLUDE_TOP)/stx/libbasic/Delay.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)SUnitNameResolver.$(O) SUnitNameResolver.$(H): SUnitNameResolver.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)TestCase.$(O) TestCase.$(H): TestCase.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)TestAsserter.$(O) TestAsserter.$(H): TestAsserter.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)TestFailure.$(O) TestFailure.$(H): TestFailure.st $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)TestResource.$(O) TestResource.$(H): TestResource.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)TestResult.$(O) TestResult.$(H): TestResult.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)TestRunner.$(O) TestRunner.$(H): TestRunner.st $(INCLUDE_TOP)/stx/libview2/ApplicationModel.$(H) $(INCLUDE_TOP)/stx/libview2/Model.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)TestSuite.$(O) TestSuite.$(H): TestSuite.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)TestSuitesScripter.$(O) TestSuitesScripter.$(H): TestSuitesScripter.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_sunit.$(O) stx_goodies_sunit.$(H): stx_goodies_sunit.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)ResumableTestFailure.$(O) ResumableTestFailure.$(H): ResumableTestFailure.st $(INCLUDE_TOP)/stx/goodies/sunit/TestFailure.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)TestCaseWithArguments.$(O) TestCaseWithArguments.$(H): TestCaseWithArguments.st $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)TestCase.$(O) TestCase.$(H): TestCase.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)TestResource.$(O) TestResource.$(H): TestResource.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Block.$(H) $(INCLUDE_TOP)/stx/libbasic/CompiledCode.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Class.$(H) $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/String.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/ByteArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Symbol.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/Make.spec Wed Jun 29 20:38:32 2011 +0200
+++ b/Make.spec Wed Jun 29 21:15:49 2011 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/goodies/sunit/Make.spec,v 1.5 2008-10-31 12:49:10 cg Exp $
+# $Header: /cvs/stx/stx/goodies/sunit/Make.spec,v 1.6 2011-06-29 19:15:49 cg Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_goodies_sunit.
@@ -49,18 +49,37 @@
# STCWARNINGS=-warnEOLComments
STCWARNINGS=-warnNonStandard
+COMMON_CLASSES= \
+ SUnitDelay \
+ SUnitNameResolver \
+ TestAsserter \
+ TestFailure \
+ TestResult \
+ TestRunner \
+ TestSuite \
+ TestSuitesScripter \
+ stx_goodies_sunit \
+ ResumableTestFailure \
+ TestCase \
+ TestResource \
+
+
+
+
COMMON_OBJS= \
$(OUTDIR)SUnitDelay.$(O) \
$(OUTDIR)SUnitNameResolver.$(O) \
- $(OUTDIR)TestCase.$(O) \
+ $(OUTDIR)TestAsserter.$(O) \
$(OUTDIR)TestFailure.$(O) \
- $(OUTDIR)TestResource.$(O) \
$(OUTDIR)TestResult.$(O) \
$(OUTDIR)TestRunner.$(O) \
$(OUTDIR)TestSuite.$(O) \
$(OUTDIR)TestSuitesScripter.$(O) \
$(OUTDIR)stx_goodies_sunit.$(O) \
$(OUTDIR)ResumableTestFailure.$(O) \
- $(OUTDIR)TestCaseWithArguments.$(O) \
+ $(OUTDIR)TestCase.$(O) \
+ $(OUTDIR)TestResource.$(O) \
+ $(OUTDIR)extensions.$(O) \
+
--- a/Makefile Wed Jun 29 20:38:32 2011 +0200
+++ b/Makefile Wed Jun 29 21:15:49 2011 +0200
@@ -1,21 +1,18 @@
#
# DO NOT EDIT
-#
-# make uses this file (Makefile) only, if there is no
-# file named "makefile" in the directory.
-# Our only task is to generate makefile and call make again
+# automagically generated from Make.proto (by make mf)
#
-
-
-.PHONY: run
-
-run: makefile
- $(MAKE) -f makefile
-
-#only needed for the definition of $(TOP)
+include ../../rules/stdHeader
+include ../../configurations/COMMON/defines
+include ../../configurations/vendorConf
+include ../../configurations/myConf
+include ../../rules/stdHeader2
+include Make.spec
include Make.proto
-makefile:
- $(TOP)/rules/stmkmf
+BASE_CONF=linux-elf/amd64_mode32
+BASE_CONF_VENDOR=linux-elf
+CONF_PACKS=
+CONF_TOOLS=
-
+include ../../rules/stdRules
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ManyTestResourceTestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,77 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResourceTestCase subclass:#ManyTestResourceTestCase
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!ManyTestResourceTestCase class methodsFor:'accessing'!
+
+resources
+ ^super resources, (Array with: SimpleTestResourceA with: SimpleTestResourceB)
+! !
+
+!ManyTestResourceTestCase class methodsFor:'testing'!
+
+shouldInheritSelectors
+ ^true
+! !
+
+!ManyTestResourceTestCase methodsFor:'running'!
+
+testTearDownOrder
+ | myResourceSetUpOrder myResourceReverseTearDownOrder |
+ myResourceReverseTearDownOrder := OrderedCollection new: 7.
+ myResourceSetUpOrder := (OrderedCollection new: 7)
+ add: SimpleTestResource;
+ add: SimpleTestResourceA1;
+ add: SimpleTestResourceA2;
+ add: SimpleTestResourceA;
+ add: SimpleTestResourceB1;
+ add: SimpleTestResourceB;
+ yourself.
+ self assert: (myResourceSetUpOrder allSatisfy: [:each | each isAvailable])
+ description: 'At test start, not all my resources were set up'.
+ self class resources do:
+ [:each | each resetOrAddResourcesTo: myResourceReverseTearDownOrder].
+ self assert: myResourceReverseTearDownOrder = myResourceSetUpOrder
+ description: 'Wrong order for tearDown'.
+ self assert: (myResourceSetUpOrder allSatisfy: [:each | each isAvailable])
+ description: 'At test start, not all my resources were set up'.
+! !
+
+!ManyTestResourceTestCase methodsFor:'utility'!
+
+clearOuterResourceStateDuring: aBlock
+ "This self-testing test must clear the outer state of its resources before starting and after finishing, so that it can construct test cases and suites of itself and test them."
+
+ self assert: SimpleTestResourceA1 isAlreadyAvailable
+ description: 'The resource was not set up for the test'.
+ SimpleTestResourceA reset.
+ SimpleTestResourceB reset.
+ SimpleTestResourceA1 reset.
+ self deny: SimpleTestResourceA1 isAlreadyAvailable
+ description: 'The resource was still set up before we began the run'.
+ ^[super clearOuterResourceStateDuring: aBlock] sunitEnsure:
+ [self deny: SimpleTestResourceA1 isAlreadyAvailable
+ description: 'The resource was still set up after we finished the run'.
+ self deny: SimpleTestResourceB1 isAlreadyAvailable
+ description: 'The resource was still set up after we finished the run'.
+ SimpleTestResourceA isAvailable.
+ self assert: SimpleTestResourceA1 isAlreadyAvailable
+ description: 'The resource was not set up again after the test'.
+ SimpleTestResourceB isAvailable.
+ self assert: SimpleTestResourceB1 isAlreadyAvailable
+ description: 'The resource was not set up again after the test'.].
+
+ "Modified: / 11-09-2010 / 16:44:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ManyTestResourceTestCase class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: ManyTestResourceTestCase.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- a/ResumableTestFailure.st Wed Jun 29 20:38:32 2011 +0200
+++ b/ResumableTestFailure.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,10 +7,27 @@
category:'SUnit-Preload'
!
+!ResumableTestFailure class methodsFor:'documentation'!
+
+documentation
+"
+ Sometimes it is useful to see when debugging (and/or to log when running) the results from several assertions in a test. Example:
+
+ #(‘same’ ‘*’ ‘*.txt’ ‘a*c’) with: #(‘same’ ‘any’ ‘some.txt’ ‘abc’) do:
+ [:eachMeta :eachString |
+ self assert: (eachMeta match: eachString)
+ description: (‘<1s> does not match <2s>’ expandMacrosWith: eachMeta with: eachString)
+ resumable: true].
+
+Raising a ResumableTestFailure means that all the assertions will be run (if the test case is logging, this will print out a message to the log for each one that fails). When debugging, the user can hit ''proceed'' to continue the test and see which other expressions do not match.'
+
+
+"
+! !
!ResumableTestFailure methodsFor:'Camp Smalltalk'!
-handleFailureWith:something
+handleFailureWith:something
"resumable test failure. Continue with the test suite"
^ self resumeWith:something
@@ -21,12 +38,17 @@
^ true
!
-sunitExitWith: something
- ^self resumeWith: something
+sunitExitWith: aValue
+
+ ^self resume: aValue
! !
!ResumableTestFailure class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/ResumableTestFailure.st,v 1.1 2003-09-26 15:56:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/ResumableTestFailure.st,v 1.2 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: ResumableTestFailure.st 204 2010-09-11 15:21:51Z vranyj1 §'
! !
--- a/ResumableTestFailureTestCase.st Wed Jun 29 20:38:32 2011 +0200
+++ b/ResumableTestFailureTestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -1,7 +1,7 @@
"{ Package: 'stx:goodies/sunit' }"
TestCase subclass:#ResumableTestFailureTestCase
- instanceVariableNames:''
+ instanceVariableNames:'duplicateFailureLog'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Tests'
@@ -10,47 +10,32 @@
!ResumableTestFailureTestCase methodsFor:'Not categorized'!
-errorTest
- 1 zork
-
-!
+resumableTestFailureTest
+ self
+ assert: false description: 'You should see more than me' resumable: true;
+ assert: false description: 'You should see more than me' resumable: true;
+ assert: false description: 'You should see me last' resumable: false;
+ assert: false description: 'You should not see me' resumable: true
+! !
+
+!ResumableTestFailureTestCase methodsFor:'logging'!
-failureLog
- ^SUnitNameResolver defaultLogDevice
-
-!
+logFailure: aString
+ duplicateFailureLog add: aString.
+ super logFailure: aString.
+! !
-failureTest
- self
- assert: false description: 'You should see me' resumable: true;
- assert: false description: 'You should see me too' resumable: true;
- assert: false description: 'You should see me last' resumable: false;
- assert: false description: 'You should not see me' resumable: true
-
+!ResumableTestFailureTestCase methodsFor:'running'!
+
+setUp
+ duplicateFailureLog := OrderedCollection with: 'In set up'.
!
-isLogging
- ^false
-
-!
-
-okTest
- self assert: true
-
-!
-
-regularTestFailureTest
- self assert: false description: 'You should see me'
-
-!
-
-resumableTestFailureTest
- self
- assert: false description: 'You should see me' resumable: true;
- assert: false description: 'You should see me too' resumable: true;
- assert: false description: 'You should see me last' resumable: false;
- assert: false description: 'You should not see me' resumable: true
-
+tearDown
+ self deny: 'You should not see me' = duplicateFailureLog last
+ description: 'We saw the ''You should not see me'' failure'.
+ self deny: 'You should see more than me' = duplicateFailureLog last
+ description: 'We did not see more than a ''You should see more than me'' failure'.
!
testResumable
@@ -63,11 +48,32 @@
result := suite run.
self assert: result failures size = 2;
assert: result errors size = 1
-
+! !
+
+!ResumableTestFailureTestCase methodsFor:'test data'!
+
+errorTest
+ 1 zork
+!
+
+failureTest
+ self
+ assert: false description: 'You should see me' resumable: true;
+ assert: false description: 'You should see me too' resumable: true;
+ assert: false description: 'You should see me last' resumable: false;
+ assert: false description: 'You should not see me' resumable: true
+!
+
+okTest
+ self assert: true
+!
+
+regularTestFailureTest
+ self assert: false description: 'You should see me'
! !
!ResumableTestFailureTestCase class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/ResumableTestFailureTestCase.st,v 1.1 2003-09-26 16:09:52 stefan Exp $'
+version_SVN
+ ^ '§Id: ResumableTestFailureTestCase.st 214 2011-03-14 12:22:21Z vranyj1 §'
! !
--- a/SUnitDelay.st Wed Jun 29 20:38:32 2011 +0200
+++ b/SUnitDelay.st Wed Jun 29 21:15:49 2011 +0200
@@ -11,5 +11,9 @@
!SUnitDelay class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitDelay.st,v 1.4 2002-02-26 10:30:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitDelay.st,v 1.5 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: SUnitDelay.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/SUnitNameResolver.st Wed Jun 29 20:38:32 2011 +0200
+++ b/SUnitNameResolver.st Wed Jun 29 21:15:49 2011 +0200
@@ -10,7 +10,7 @@
!SUnitNameResolver class methodsFor:'Camp Smalltalk'!
-classNamed: aSymbol
+classNamed: aSymbol
^Smalltalk at: aSymbol ifAbsent: [nil]
!
@@ -18,21 +18,28 @@
^Transcript
!
-errorObject
- ^Exception
-"/ ^Error
+errorObject
+
+ ^Exception
+"/ ^Error
+
+ "Modified: / 11-09-2010 / 15:10:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-mnuExceptionObject
- ^MessageNotUnderstood
+mnuExceptionObject
+ ^MessageNotUnderstood
!
-notificationObject
- ^Notification
+notificationObject
+ ^Notification
! !
!SUnitNameResolver class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitNameResolver.st,v 1.6 2004-02-18 10:21:22 penk Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitNameResolver.st,v 1.7 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: SUnitNameResolver.st 204 2010-09-11 15:21:51Z vranyj1 §'
! !
--- a/SUnitTest.st Wed Jun 29 20:38:32 2011 +0200
+++ b/SUnitTest.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,11 +7,11 @@
category:'SUnit-Tests'
!
-SUnitTest comment:'This is both an example of writing tests and a self test for the SUnit. The tests
-here are pretty strange, since you want to make sure things blow up. You should
-not generally have to write tests this complicated in structure, although they
-will be far more complicated in terms of your own objects- more assertions, more
-complicated setup. Kent says: "Never forget, however, that if the tests are hard
+SUnitTest comment:'This is both an example of writing tests and a self test for the SUnit. The tests
+here are pretty strange, since you want to make sure things blow up. You should
+not generally have to write tests this complicated in structure, although they
+will be far more complicated in terms of your own objects- more assertions, more
+complicated setup. Kent says: "Never forget, however, that if the tests are hard
to write, something is probably wrong with the design".'
!
@@ -20,12 +20,10 @@
hasRun
^hasRun
-
!
hasSetup
^hasSetup
-
! !
!SUnitTest methodsFor:'private'!
@@ -37,53 +35,46 @@
assert: aResult passedCount = aPassedCount;
assert: aResult failureCount = aFailureCount;
assert: aResult errorCount = anErrorCount
-
!
error
3 zork
-
!
fail
self assert: false
-
!
failAndError
- self assert: false.
- self assert: false. " second failure "
- self error.
+ self assert: false.
+ self assert: false. " second failure "
+ self error.
!
noop
-
!
setRun
hasRun := true
-
! !
!SUnitTest methodsFor:'running'!
setUp
hasSetup := true
-
! !
!SUnitTest methodsFor:'testing'!
errorShouldntRaise
- self
- shouldnt: [self someMessageThatIsntUnderstood]
- raise: SUnitNameResolver notificationObject
+ self
+ shouldnt: [self someMessageThatIsntUnderstood]
+ raise: SUnitNameResolver notificationObject
!
testAssert
self assert: true.
self deny: false
-
!
testDefects
@@ -99,7 +90,6 @@
passed: 0
failed: 1
errors: 1
-
!
testDialectLocalizedException
@@ -110,8 +100,6 @@
self
should: [TestResult signalErrorWith: 'Foo']
raise: TestResult error.
-
-
!
testError
@@ -129,13 +117,12 @@
case := self class selector: #errorShouldntRaise.
result := case run.
- self
+ self
assertForTestResult: result
runCount: 1
passed: 0
failed: 0
errors: 1
-
!
testException
@@ -143,7 +130,6 @@
self
should: [self error: 'foo']
raise: TestResult error
-
!
testFail
@@ -159,25 +145,6 @@
passed: 0
failed: 1
errors: 0
-
-!
-
-testFailAndError
-
- " verify that two resumable failures that are followed by
- an error are counted as one error. "
-
- | case result |
-
- case := self class selector: #failAndError.
- result := case run.
-
- self
- assertForTestResult: result
- runCount: 1
- passed: 0
- failed: 0
- errors: 1
!
testIsNotRerunOnDebug
@@ -187,7 +154,6 @@
case := self class selector: #testRanOnlyOnce.
case run.
case debug
-
!
testRan
@@ -198,14 +164,12 @@
case run.
self assert: case hasSetup.
self assert: case hasRun
-
!
testRanOnlyOnce
self assert: hasRanOnce ~= true.
hasRanOnce := true
-
!
testResult
@@ -221,12 +185,11 @@
passed: 1
failed: 0
errors: 0
-
!
testRunning
- (Delay forSeconds: 2) wait
+ (SUnitDelay forSeconds: 2) wait
!
testShould
@@ -234,7 +197,6 @@
self
should: [true];
shouldnt: [false]
-
!
testSuite
@@ -242,7 +204,7 @@
| suite result |
suite := TestSuite new.
- suite
+ suite
addTest: (self class selector: #noop);
addTest: (self class selector: #fail);
addTest: (self class selector: #error).
@@ -255,11 +217,14 @@
passed: 1
failed: 1
errors: 1
-
! !
!SUnitTest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitTest.st,v 1.10 2006-08-28 14:52:50 boris Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/SUnitTest.st,v 1.11 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: SUnitTest.st 214 2011-03-14 12:22:21Z vranyj1 §'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResource.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,99 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+TestResource subclass:#SimpleTestResource
+ instanceVariableNames:'runningState hasRun hasSetup'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+SimpleTestResource class instanceVariableNames:'preventAvailability'
+
+"
+ The following class instance variables are inherited by this class:
+
+ TestResource - current
+ TestAsserter -
+ Object -
+"
+!
+
+
+!SimpleTestResource class methodsFor:'accessing'!
+
+allowAvailability
+ ^preventAvailability isNil
+!
+
+rawCurrentForTest
+ ^current
+! !
+
+!SimpleTestResource class methodsFor:'utility'!
+
+preventAvailabilityDuring: aBlock
+ "Only setter of preventAvailability."
+
+ preventAvailability := false.
+ ^aBlock ensure: [preventAvailability := nil]
+! !
+
+!SimpleTestResource methodsFor:'accessing'!
+
+runningState
+
+ ^runningState
+!
+
+runningState: aSymbol
+
+ runningState := aSymbol
+! !
+
+!SimpleTestResource methodsFor:'running'!
+
+setRun
+ hasRun := true
+!
+
+setUp
+
+ self runningState: self startedStateSymbol.
+ hasSetup := true
+!
+
+startedStateSymbol
+
+ ^#started
+!
+
+stoppedStateSymbol
+
+ ^#stopped
+!
+
+tearDown
+
+ self runningState: self stoppedStateSymbol
+! !
+
+!SimpleTestResource methodsFor:'testing'!
+
+hasRun
+ ^hasRun
+!
+
+hasSetup
+ ^hasSetup
+!
+
+isAvailable
+ ^self class allowAvailability and:
+ [self runningState == self startedStateSymbol]
+! !
+
+!SimpleTestResource class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResource.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceA.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceA
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceA class methodsFor:'accessing'!
+
+resources
+ ^Array with: SimpleTestResourceA1 with: SimpleTestResourceA2
+! !
+
+!SimpleTestResourceA class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceA.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceA1.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,15 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceA1
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceA1 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceA1.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceA2.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,15 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceA2
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceA2 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceA2.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceB.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,21 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceB
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceB class methodsFor:'accessing'!
+
+resources
+ ^Array with: SimpleTestResourceA1 with: SimpleTestResourceB1
+! !
+
+!SimpleTestResourceB class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceB.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceB1.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,15 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceB1
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceB1 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceB1.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceCircular.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceCircular
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceCircular class methodsFor:'accessing'!
+
+resources
+ ^preventAvailability isNil
+ ifTrue: [super resources, (Array with: SimpleTestResourceA1)]
+ ifFalse: [super resources, (Array with: SimpleTestResourceA1 with: SimpleTestResourceCircular1)]
+! !
+
+!SimpleTestResourceCircular class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceCircular.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SimpleTestResourceCircular1.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,23 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+SimpleTestResource subclass:#SimpleTestResourceCircular1
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Tests'
+!
+
+
+!SimpleTestResourceCircular1 class methodsFor:'accessing'!
+
+resources
+ "Circular prereq: C wants C1 which wants C."
+
+ ^Array with: SimpleTestResourceCircular
+! !
+
+!SimpleTestResourceCircular1 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceCircular1.st 214 2011-03-14 12:22:21Z vranyj1 §'
+! !
--- a/SimpleTestResourceTestCase.st Wed Jun 29 20:38:32 2011 +0200
+++ b/SimpleTestResourceTestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,48 +7,15 @@
category:'SUnit-Tests'
!
-TestResource subclass:#SimpleTestResource
- instanceVariableNames:'runningState hasRun hasSetup hasRanOnce'
- classVariableNames:''
- poolDictionaries:''
- privateIn:SimpleTestResourceTestCase
-!
-
-!SimpleTestResourceTestCase class methodsFor:'Not categorized'!
+!SimpleTestResourceTestCase class methodsFor:'accessing'!
resources
- ^Set new add: SimpleTestResource; yourself
-
+ ^Array with: SimpleTestResource
! !
!SimpleTestResourceTestCase methodsFor:'Not categorized'!
-dummy
- self assert: true
-
-!
-
-error
- 'foo' odd
-
-!
-
-fail
- self assert: false
-
-!
-
-setRun
- resource setRun
-
-!
-
-setUp
- resource := SimpleTestResource current
-
-!
-
testRan
| case |
@@ -56,7 +23,7 @@
case run.
self assert: resource hasSetup.
self assert: resource hasRun
-
+
!
testResourceInitRelease
@@ -67,82 +34,103 @@
suite addTest: (self class selector: #dummy).
result := suite run.
self assert: resource hasSetup
-
-!
-testResourcesCollection
- | collection |
- collection := self resources.
- self assert: collection size = 1
-
! !
-!SimpleTestResourceTestCase::SimpleTestResource methodsFor:'accessing'!
+!SimpleTestResourceTestCase methodsFor:'private'!
-runningState
-
- ^runningState
-
+dummy
+ self assert: resource hasSetup
+ description: 'This test uses a resource but it was not set up'.
+ self setRun.
+ self assert: resource hasRun
+ description: 'This test uses a resource but we could not interact with it'.
!
-runningState: aSymbol
+error
+ 'foo' odd
+!
- runningState := aSymbol
-
+fail
+ self assert: false
+!
+
+setRun
+ resource setRun
! !
-!SimpleTestResourceTestCase::SimpleTestResource methodsFor:'running'!
-
-setRun
- hasRun := true
-
-!
+!SimpleTestResourceTestCase methodsFor:'running'!
setUp
-
- self runningState: self startedStateSymbol.
- hasSetup := true
-
+ "Ensure that we error, not just fail, if resource is nil so that #should:raise: checks cannot mistake such an error for what they are trapping."
+
+ resource := SimpleTestResource rawCurrentForTest.
+ self deny: resource isNil
+ description: 'SimpleTestResource has no current value in test'.
+ self assert: resource class == SimpleTestResource
+ description: 'SimpleTestResource current is not an instance of itself'.
+ self assert: resource hasSetup
+ description: 'This test uses a resource but it was not set up'.
!
-startedStateSymbol
+testDebugTestWithResource
+ "The debug will raise an error if the resource is not set up properly."
- ^#started
-
+ self clearOuterResourceStateDuring:
+ [(self class selector: #setRun) debug].
!
-stoppedStateSymbol
-
- ^#stopped
-
+testResourceCollection
+ self assert: self class buildSuiteFromSelectors resources size = self resources size
+ description: 'The suite should have the same number of resources as its test'.
+ self class buildSuiteFromSelectors resources do:
+ [:each |
+ self assert: (self resources includes: each)
+ description: each name, ': I have this resource but my suite does not'].
!
-tearDown
+testRunSuiteWithResource
+ | suite |
+ suite := TestSuite new.
+ suite addTest: (SimpleTestResourceTestCase selector: #error).
+ suite addTest: (SimpleTestResourceTestCase selector: #fail).
+ suite addTest: (self class selector: #dummy).
+ self clearOuterResourceStateDuring:
+ [self assert: suite run printString = '3 run, 1 passed, 1 failed, 1 error'
+ description: 'A suite of tests needing SimpleTestResource did not run as expected'].
+!
- self runningState: self stoppedStateSymbol
-
+testRunTestWithResource
+ self clearOuterResourceStateDuring:
+ [self assert: (self class selector: #dummy) run printString
+ = '1 run, 1 passed, 0 failed, 0 errors'
+ description: 'A dummy test that needed a resource did not pass'].
! !
-!SimpleTestResourceTestCase::SimpleTestResource methodsFor:'testing'!
+!SimpleTestResourceTestCase methodsFor:'utility'!
-hasRun
- ^hasRun
-
-!
+clearOuterResourceStateDuring: aBlock
+ "This self-testing test must clear the outer state of its resources before starting and after finishing, so that it can construct test cases and suites of itself and test them."
-hasSetup
- ^hasSetup
-
-!
-
-isAvailable
-
- ^self runningState == self startedStateSymbol
-
+ self assert: SimpleTestResource isAlreadyAvailable
+ description: 'The resource was not set up for the test'.
+ SimpleTestResource reset.
+ self deny: SimpleTestResource isAlreadyAvailable
+ description: 'The resource was still set up before we began the run'.
+ ^aBlock sunitEnsure:
+ [self deny: SimpleTestResource isAlreadyAvailable
+ description: 'The resource was still set up after we finished the run'.
+ SimpleTestResource isAvailable.
+ self assert: SimpleTestResource isAlreadyAvailable
+ description: 'The resource was not set up again after the test'].
! !
!SimpleTestResourceTestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/SimpleTestResourceTestCase.st,v 1.1 2003-09-26 16:01:01 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/SimpleTestResourceTestCase.st,v 1.2 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: SimpleTestResourceTestCase.st 214 2011-03-14 12:22:21Z vranyj1 §'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestAsserter.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,205 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestAsserter
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Base'
+!
+
+TestAsserter comment:''
+!
+
+
+!TestAsserter class methodsFor:'asserting'!
+
+assert: aBoolean description: aString
+ "Minimal clone of the instance-side assert protocol so that class-side methods can use it."
+
+ aBoolean ifFalse:
+ [self logFailure: aString.
+ TestResult failure sunitSignalWith: aString].
+! !
+
+!TestAsserter class methodsFor:'logging'!
+
+failureLog
+ ^SUnitNameResolver defaultLogDevice
+!
+
+isLogging
+ "By default, we're not logging failures. Override in subclasses as desired."
+
+ ^false
+!
+
+logFailure: aString
+ self isLogging ifTrue:
+ [self failureLog cr; nextPutAll: aString; flush].
+! !
+
+!TestAsserter methodsFor:'asserting'!
+
+assert: aBoolean
+
+ <resource: #skipInDebuggersWalkBack>
+
+ aBoolean ifFalse:
+ [self logFailure: 'Assertion failed'.
+ TestResult failure sunitSignalWith: 'Assertion failed'].
+
+ "Modified: / 05-12-2009 / 18:14:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+assert:aBoolean description:aString
+ <resource: #skipInDebuggersWalkBack>
+
+ ^self assert:aBoolean description:aString resumable: false.
+
+ "Modified: / 06-08-2006 / 22:56:27 / cg"
+ "Modified: / 11-09-2010 / 15:34:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+assert: aBoolean description: aString resumable: resumableBoolean
+
+ <resource: #skipInDebuggersWalkBack>
+ | exception |
+ aBoolean ifFalse:
+ [self logFailure: aString.
+ exception := resumableBoolean
+ ifTrue: [TestResult resumableFailure]
+ ifFalse: [TestResult failure].
+ exception sunitSignalWith: aString].
+
+ "Modified: / 05-12-2009 / 18:15:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+deny: aBoolean
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self assert: aBoolean not.
+
+ "Modified: / 05-12-2009 / 18:16:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+deny: aBoolean description: aString
+
+ <resource: #skipInDebuggersWalkBack>
+ self assert: aBoolean not description: aString.
+
+ "Modified: / 05-12-2009 / 18:17:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+deny: aBoolean description: aString resumable: resumableBoolean
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self assert: aBoolean not description: aString resumable: resumableBoolean.
+
+ "Modified: / 05-12-2009 / 18:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+should: aBlock raise: anExceptionalEvent
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent).
+
+ "Modified: / 05-12-2009 / 18:18:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+should: aBlock raise: anExceptionalEvent description: aString
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self
+ assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
+ description: aString.
+
+ "Modified: / 05-12-2009 / 18:18:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+should: aBlock raise: anExceptionalEvent suchThat: condBlock
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent suchThat: condBlock).
+
+ "Created: / 05-05-2011 / 20:14:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+should: aBlock raise: anExceptionalEvent suchThat: condBlock description: description
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent suchThat: condBlock)
+ description: description
+
+ "Created: / 05-05-2011 / 20:14:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+shouldnt: aBlock raise: anExceptionalEvent
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self
+ assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not.
+
+ "Modified: / 05-12-2009 / 18:18:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+shouldnt: aBlock raise: anExceptionalEvent description: aString
+
+ <resource: #skipInDebuggersWalkBack>
+
+ self
+ assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
+ description: aString.
+
+ "Modified: / 05-12-2009 / 18:18:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestAsserter methodsFor:'convenience'!
+
+assert: anObject equals: anotherObject
+ self assert: anObject = anotherObject
+ description: anObject printString, ' is not equal to ', anotherObject printString.
+! !
+
+!TestAsserter methodsFor:'logging'!
+
+logFailure: aString
+ self class logFailure: aString.
+! !
+
+!TestAsserter methodsFor:'private'!
+
+executeShould: execBlock inScopeOf: exceptionalEvent
+
+ <resource: #skipInDebuggersWalkBack>
+
+ ^ self
+ executeShould: execBlock
+ inScopeOf: exceptionalEvent
+ suchThat: [:ex | true ]
+
+ "Modified: / 05-05-2011 / 20:23:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+executeShould: execBlock inScopeOf: exceptionalEvent suchThat: conditionBlock
+ ^[execBlock value.
+ false]
+ sunitOn: exceptionalEvent
+ do:
+ [:ex |
+ ex sunitExitWith:(conditionBlock value: ex)]
+
+ "Created: / 05-05-2011 / 20:08:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestAsserter class methodsFor:'documentation'!
+
+version_SVN
+ ^ '§Id: TestAsserter.st 217 2011-05-05 19:33:11Z vranyj1 §'
+! !
--- a/TestCase.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestCase.st Wed Jun 29 21:15:49 2011 +0200
@@ -1,24 +1,21 @@
"{ Package: 'stx:goodies/sunit' }"
-Object subclass:#TestCase
+TestAsserter subclass:#TestCase
instanceVariableNames:'testSelector'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
-TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
+TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsPassedTests lastTestRunsFailedTests
+ lastTestRunsErrorTests'
"
No other class instance variables are inherited by this class.
"
!
-TestCase comment:'A TestCase is a Command representing the future running of a test case. Create one with the class method #selector: aSymbol, passing the name of the method to be run when the test case runs.
-
-When you discover a new fixture, subclass TestCase, declare instance variables for the objects in the fixture, override #setUp to initialize the variables, and possibly override# tearDown to deallocate any external resources allocated in #setUp.
-
-When you are writing a test case method, send #assert: aBoolean when you want to check for an expected value. For example, you might say "self assert: socket isOpen" to test whether or not a socket is open at a point in a test.'
+TestCase comment:''
!
@@ -37,41 +34,42 @@
debug: aSymbol
^(self selector: aSymbol) debug
-
!
run: aSymbol
^(self selector: aSymbol) run
-
!
selector: aSymbol
^self new setTestSelector: aSymbol
-
!
suite
^self buildSuite
-
! !
!TestCase class methodsFor:'accessing'!
allTestSelectors
-
- ^ (self allSelectors select: [:each | self isTestSelector:each]) asOrderedCollection sort
-
- "Modified: / 06-08-2006 / 11:46:32 / cg"
+ | answer pivotClass lookupRoot |
+ answer := Set withAll: self testSelectors.
+ self shouldInheritSelectors ifTrue:
+ [pivotClass := self.
+ lookupRoot := self lookupHierarchyRoot.
+ [pivotClass == lookupRoot] whileFalse:
+ [pivotClass := pivotClass superclass.
+ answer addAll: pivotClass testSelectors]].
+ ^answer asSortedCollection asOrderedCollection
!
forgetLastTestRunResult
lastTestRunResultOrNil ~~ nil ifTrue:[
- lastTestRunResultOrNil := nil.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := nil.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:40:07 / cg"
@@ -79,37 +77,79 @@
isTestSelector:aSelector
- ^aSelector ~= #testName
- and:[aSelector startsWith: 'test']
+ ^aSelector startsWith:'test'
"Created: / 06-08-2006 / 11:46:17 / cg"
- "Modified: / 19-08-2009 / 14:42:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 05-12-2009 / 18:50:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lastTestRunResult
+
+ | result |
+ result := TestResult new.
+ lastTestRunsPassedTests ? #() do:
+ [:selector|result passed add: (self selector: selector)].
+ lastTestRunsFailedTests ? #() do:
+ [:selector|result failures add: (self selector: selector)].
+ lastTestRunsErrorTests ? #() do:
+ [:selector|result errors add: (self selector: selector)].
+
+ "Created: / 15-03-2010 / 19:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lastTestRunResultOrNil
^ lastTestRunResultOrNil
!
-rememberFailedTest:selector
- lastTestRunsFailedTests isNil ifTrue:[
- lastTestRunsFailedTests := Set new.
+lookupHierarchyRoot
+ ^TestCase
+!
+
+rememberErrorTest:selector
+
+ | emitChange |
+
+ lastTestRunsErrorTests isNil ifTrue:[
+ lastTestRunsErrorTests := Set new.
].
-
- (lastTestRunsFailedTests includes:selector) ifFalse:[
- lastTestRunsFailedTests add:selector.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
- self changed:#lastTestRunResult with:selector.
- ].
+
+ emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
+ emitChange := (self removeSelector: selector from: lastTestRunsFailedTests) or:[emitChange].
+ emitChange := (self addSelector: selector to: lastTestRunsErrorTests) or:[emitChange].
+
+ emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
self rememberFailedTestRun
"Modified: / 06-08-2006 / 11:01:08 / cg"
+ "Created: / 15-03-2010 / 19:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+rememberFailedTest:selector
+
+ | emitChange |
+
+ lastTestRunsFailedTests isNil ifTrue:[
+ lastTestRunsFailedTests := Set new.
+ ].
+
+ emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
+ emitChange := (self removeSelector: selector from: lastTestRunsErrorTests) or:[emitChange].
+ emitChange := (self addSelector: selector to: lastTestRunsFailedTests) or:[emitChange].
+
+ emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
+ self rememberFailedTestRun
+
+ "Modified: / 06-08-2006 / 11:01:08 / cg"
+ "Modified: / 15-03-2010 / 19:15:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberFailedTestRun
lastTestRunResultOrNil ~~ false ifTrue:[
- lastTestRunResultOrNil := false.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := false.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:00:42 / cg"
@@ -124,7 +164,7 @@
rememberFailedTestsFromResult:result
(result failures union:result errors) do:[:eachFailedTest |
- self rememberFailedTest:(eachFailedTest selector).
+ self rememberFailedTest:(eachFailedTest selector).
].
"Created: / 05-08-2006 / 12:45:01 / cg"
@@ -132,35 +172,40 @@
!
rememberPassedTest:selector
- lastTestRunsFailedTests notNil ifTrue:[
- (lastTestRunsFailedTests includes:selector) ifTrue:[
- lastTestRunsFailedTests remove:selector ifAbsent:nil.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
- self changed:#lastTestRunResult with:selector.
- lastTestRunsFailedTests isEmpty ifTrue:[
- lastTestRunsFailedTests := nil.
- self forgetLastTestRunResult.
- ].
- ].
+
+ | emitChange |
+
+ lastTestRunsPassedTests isNil ifTrue:[
+ lastTestRunsPassedTests := Set new.
].
- "Modified: / 06-08-2006 / 11:40:16 / cg"
+ emitChange := (self removeSelector: selector from: lastTestRunsFailedTests).
+ emitChange := (self removeSelector: selector from: lastTestRunsErrorTests) or:[emitChange].
+ emitChange := (self addSelector: selector to: lastTestRunsPassedTests) or:[emitChange].
+
+ emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
+ self rememberPassedTestRun
+
+ "Modified: / 06-08-2006 / 11:01:08 / cg"
+ "Modified: / 15-03-2010 / 19:15:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberPassedTestRun
lastTestRunResultOrNil ~~ true ifTrue:[
- lastTestRunResultOrNil := true.
- lastTestRunsFailedTests := nil.
- Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
- self changed:#lastTestRunResult.
+ lastTestRunResultOrNil := true.
+ "/lastTestRunsFailedTests := nil.
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+ self changed:#lastTestRunResult.
]
"Modified: / 06-08-2006 / 11:01:22 / cg"
+ "Modified: / 15-03-2010 / 18:22:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberPassedTestsFromResult:result
(result passed) do:[:eachPassedTest |
- self rememberPassedTest:(eachPassedTest selector).
+ self rememberPassedTest:(eachPassedTest selector).
].
"Created: / 06-08-2006 / 10:29:47 / cg"
@@ -170,32 +215,36 @@
resources
^#()
-
+!
+
+shouldFork
+
+ ^false
+
+ "Created: / 13-06-2011 / 16:46:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sunitVersion
- ^'3.1'
-
+ ^'4.0'
+!
+
+testSelectorError:selector
+ ^ lastTestRunsErrorTests notNil and:[lastTestRunsErrorTests includes:selector]
+
+ "Created: / 15-03-2010 / 19:44:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testSelectorFailed:selector
- ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
+ ^ (lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]) or:
+ [lastTestRunsErrorTests notNil and:[lastTestRunsErrorTests includes:selector]]
+
+ "Modified: / 15-03-2010 / 19:44:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-testSelectors
- "the default here is all methods in a test*-category;
- this can, of course, be redefined in a testCase-class, which knows better"
-
- ^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort
+testSelectorPassed:selector
+ ^ lastTestRunsPassedTests notNil and:[lastTestRunsPassedTests includes:selector]
- "Modified: / 24-04-2010 / 14:04:51 / cg"
-!
-
-testedClasses
- "for the browser and for coverage analysis:
- return a collection of classNames, which are tested by this testCase"
-
- ^ #()
+ "Created: / 15-03-2010 / 17:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestCase class methodsFor:'building suites'!
@@ -203,25 +252,12 @@
buildSuite
| suite |
^self isAbstract
- ifTrue:
+ ifTrue:
[suite := self suiteClass named: self name asString.
- self allSubclasses
+ self allSubclasses
do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
suite]
ifFalse: [self buildSuiteFromSelectors]
-
-!
-
-buildSuiteFromAllSelectors
-
- ^self buildSuiteFromMethods: self allTestSelectors
-
-!
-
-buildSuiteFromLocalSelectors
-
- ^self buildSuiteFromMethods: self testSelectors
-
!
buildSuiteFromMethods: testMethods
@@ -232,20 +268,14 @@
suite
addTest: (self selector: selector);
yourself]
-
!
buildSuiteFromSelectors
-
- ^self shouldInheritSelectors
- ifTrue: [self buildSuiteFromAllSelectors]
- ifFalse: [self buildSuiteFromLocalSelectors]
-
+ ^self buildSuiteFromMethods: self allTestSelectors
!
suiteClass
^TestSuite
-
! !
!TestCase class methodsFor:'misc ui support'!
@@ -259,14 +289,56 @@
lastResult := self lastTestRunResultOrNil.
lastResult == true ifTrue:[
- ^ #testCasePassedIcon
+ ^ #testCasePassedIcon
].
lastResult == false ifTrue:[
- ^ #testCaseFailedIcon
+ ^ #testCaseFailedIcon
].
^ #testCaseClassIcon
! !
+!TestCase class methodsFor:'private'!
+
+addSelector: selector to: collection
+
+ "Adds given selector from collection. Answers
+ true iff selector was really added"
+
+ ^(collection includes: selector)
+ ifTrue:[false]
+ ifFalse:[collection add: selector. true]
+
+ "Created: / 15-03-2010 / 18:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-04-2010 / 23:19:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lastTestRunResultChanged: selector
+
+ Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
+ self changed:#lastTestRunResult with:selector.
+
+ "Created: / 15-03-2010 / 19:15:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+removeSelector: selector from: collection
+
+ "Removes given selector from collection. Answers
+ true iff selector was really removed"
+
+ collection ifNil:[^false]." trivial case "
+ ^(collection includes: selector)
+ ifTrue:[collection remove: selector. true]
+ ifFalse:[false]
+
+ "Created: / 15-03-2010 / 18:05:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSelectors
+ "The API method is allTestSelectors which now includes #shouldInheritSelectors and so handles all cases. Unlike that method, this does not guarantee to return a sorted ordered collection."
+
+ ^self sunitSelectors select: [:each | 'test*' sunitMatch: each]
+! !
+
!TestCase class methodsFor:'quick testing'!
assert: aBoolean
@@ -288,17 +360,24 @@
!TestCase class methodsFor:'testing'!
isAbstract
- "Override to true if a TestCase subclass is Abstract and should not have
- TestCase instances built from it"
-
- ^ self == TestCase
+ "Override to true if a TestCase subclass is Abstract and should not have
+ TestCase instances built from it"
+
+ ^self sunitName = #TestCase
+!
+
+isTestCaseLike
+
+ ^true
+
+ "Created: / 06-03-2011 / 00:16:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberResult:result
result hasPassed ifTrue:[
- self rememberPassedTestRun
+ self rememberPassedTestRun
] ifFalse:[
- self rememberFailedTestRunWithResult:result
+ self rememberFailedTestRunWithResult:result
].
"Created: / 05-08-2006 / 12:33:08 / cg"
@@ -316,32 +395,28 @@
shouldInheritSelectors
"I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass. If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."
- ^self superclass isAbstract
- or: [self testSelectors isEmpty]
-
-"$QA Ignore:Sends system method(superclass)$"
-
+ ^self ~~ self lookupHierarchyRoot
+ and: [self superclass isAbstract
+ or: [self testSelectors isEmpty]]
! !
!TestCase methodsFor:'accessing'!
resources
- | allResources resourceQueue |
- allResources := Set new.
- resourceQueue := OrderedCollection new.
- resourceQueue addAll: self class resources.
- [resourceQueue isEmpty] whileFalse: [
- | next |
- next := resourceQueue removeFirst.
- allResources add: next.
- resourceQueue addAll: next resources].
- ^allResources
-
+ "We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical. Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought. If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate."
+
+ ^self class resources
!
selector
^testSelector
-
+!
+
+shouldFork
+
+ ^self class shouldFork
+
+ "Created: / 13-06-2011 / 16:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestCase methodsFor:'accessing & queries'!
@@ -353,16 +428,6 @@
!TestCase methodsFor:'assertions'!
-assert: aBoolean
- "fail, if the argument is not true"
-
- <resource: #skipInDebuggersWalkBack>
-
-"/ aBoolean ifFalse: [self signalFailure: 'Assertion failed']
-
- self assert: aBoolean message:'Assertion failed'
-!
-
assert:aBlock completesInSeconds:aNumber
"fail, if aBlock does not finish its work in aNumber seconds"
@@ -373,13 +438,13 @@
done := false.
semaphore := Semaphore new.
process := [
- aBlock value.
- done := true.
- semaphore signal
+ aBlock value.
+ done := true.
+ semaphore signal
] fork.
semaphore waitWithTimeout: aNumber.
process terminate.
- self assert: done
+ self assert: done
"
self new assert:[Delay waitForSeconds:2] completesInSeconds:1
@@ -389,37 +454,11 @@
"
!
-assert:aBoolean description:aString
- <resource: #skipInDebuggersWalkBack>
-
- aBoolean ifFalse:[
- self logFailure:aString.
- self signalFailure:aString resumable:true
- ]
-
- "Modified: / 06-08-2006 / 22:56:27 / cg"
-!
-
-assert:aBoolean description:aString resumable:resumableBoolean
- <resource: #skipInDebuggersWalkBack>
+assert: aBoolean message:messageIfFailing
- aBoolean ifFalse:[
- self logFailure:aString.
- self signalFailure:aString resumable:resumableBoolean
- ]
-!
-
-assert: aBoolean message:messageIfFailing
- "fail, if the argument is not true"
+ ^self assert: aBoolean description: messageIfFailing
- <resource: #skipInDebuggersWalkBack>
-
- "check the testCase itself"
- (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
- aBoolean ifFalse: [self signalFailure: messageIfFailing resumable:true]
-
- "Modified: / 21-06-2000 / 10:00:05 / Sames"
- "Modified: / 06-08-2006 / 22:56:21 / cg"
+ "Modified: / 05-12-2009 / 18:16:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
assertFalse:aBoolean
@@ -434,7 +473,7 @@
^ self assert:aBoolean not
!
-assertTrue:aBoolean
+assertTrue:aBoolean
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean
@@ -444,130 +483,64 @@
<resource: #skipInDebuggersWalkBack>
^ self assert:aBoolean
-!
-
-deny:aBoolean
- "fail, if the argument is not false"
-
- <resource: #skipInDebuggersWalkBack>
-
- self assert:aBoolean not
-!
-
-deny: aBoolean description: aString
- <resource: #skipInDebuggersWalkBack>
-
- self assert: aBoolean not description: aString
-!
-
-deny: aBoolean description: aString resumable: resumableBoolean
- <resource: #skipInDebuggersWalkBack>
-
- self
- assert: aBoolean not
- description: aString
- resumable: resumableBoolean
-!
-
-should:aBlock
- "fail, if the block does not evaluate to true"
-
- <resource: #skipInDebuggersWalkBack>
-
- self assert:aBlock value
-!
-
-should: aBlock description: aString
- <resource: #skipInDebuggersWalkBack>
-
- self assert: aBlock value description: aString
-!
-
-should:aBlock raise:anExceptionalEvent
- "fail, if the block does not raise the given event"
-
- <resource: #skipInDebuggersWalkBack>
-
- ^ self assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent)
-!
-
-should: aBlock raise: anExceptionalEvent description: aString
- <resource: #skipInDebuggersWalkBack>
-
- ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
- description: aString
-!
-
-shouldnt:aBlock
- "fail, if the block does evaluate to true"
-
- <resource: #skipInDebuggersWalkBack>
-
- self deny:aBlock value
-!
-
-shouldnt: aBlock description: aString
- <resource: #skipInDebuggersWalkBack>
-
- self deny: aBlock value description: aString
-!
-
-shouldnt:aBlock raise:anExceptionalEvent
- "fail, if the block does raise the given event"
-
- <resource: #skipInDebuggersWalkBack>
-
- ^ self
- assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent) not
-!
-
-shouldnt: aBlock raise: anExceptionalEvent description: aString
- <resource: #skipInDebuggersWalkBack>
-
- ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not description: aString
! !
!TestCase methodsFor:'dependencies'!
-addDependentToHierachy: anObject
+addDependentToHierachy: anObject
"an empty method. for Composite compability with TestSuite"
+!
+removeDependentFromHierachy: anObject
+ "an empty method. for Composite compability with TestSuite"
+! !
-
+!TestCase methodsFor:'deprecated'!
+
+should: aBlock
+ self assert: aBlock value
!
-removeDependentFromHierachy: anObject
- "an empty method. for Composite compability with TestSuite"
+should: aBlock description: aString
+ self assert: aBlock value description: aString
+!
+shouldnt: aBlock
+ self deny: aBlock value
+!
-
+shouldnt: aBlock description: aString
+ self deny: aBlock value description: aString
+!
+
+signalFailure: aString
+ TestResult failure sunitSignalWith: aString.
! !
!TestCase methodsFor:'printing'!
+getTestName
+
+ ^testSelector.
+
+ "Modified: / 05-12-2009 / 17:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
name
- ^ self class name.
+ ^ self class name.
!
printOn: aStream
-"/ aStream
-"/ nextPutAll: self class printString;
-"/ nextPutAll: '>>#';
-"/ nextPutAll: testSelector
-
- aStream nextPutAll: self name.
- aStream nextPutAll: '>>'.
- testSelector printOn: aStream
-!
-
-testName
- ^ testSelector.
+ aStream
+ nextPutAll: self class printString;
+ nextPutAll: '>>#';
+ nextPutAll: testSelector
! !
!TestCase methodsFor:'private'!
-executeShould: aBlock inScopeOf: anExceptionalEvent
+executeShould: aBlock inScopeOf: anExceptionalEvent
"/ ^[aBlock value.
"/ false] sunitOn: anExceptionalEvent
"/ do: [:ex | ex sunitExitWith: true]
@@ -577,43 +550,36 @@
"/ do: [:ex | ^true]]
"/ on: TestResult exError
"/ do: [:ex | ^false].
- aBlock
- on: anExceptionalEvent
- do: [:ex | ^true].
+ [aBlock value]
+ on: anExceptionalEvent
+ do: [:ex | ^true].
- ^false.
+ ^false.
!
performTest
- self perform: testSelector asSymbol
+ self perform: testSelector sunitAsSymbol
!
setTestSelector: aSymbol
testSelector := aSymbol
-
!
-signalFailure: aString
-
-"/ TestResult failure sunitSignalWith: aString
- TestResult failure raiseErrorString:aString in:thisContext sender sender .
-!
-
-signalFailure:aString resumable:isResumable
+signalFailure:aString resumable:isResumable
"/ TestResult failure sunitSignalWith: aString
<resource: #skipInDebuggersWalkBack>
isResumable ifTrue:[
- TestResult resumableFailure
- raiseRequestWith:nil
- errorString:aString
- in:thisContext sender sender
+ TestResult resumableFailure
+ raiseRequestWith:nil
+ errorString:aString
+ in:thisContext sender sender
] ifFalse:[
- TestResult failure
- raiseErrorString:aString
- in:thisContext sender sender
+ TestResult failure
+ raiseErrorString:aString
+ in:thisContext sender sender
].
"Modified: / 06-08-2006 / 22:55:55 / cg"
@@ -621,10 +587,10 @@
signalUnavailableResources
- self resources do:[:res |
- res isAvailable ifFalse:[
- ^ res signalInitializationError
- ]
+ self resources do:[:res |
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
].
! !
@@ -647,52 +613,33 @@
!TestCase methodsFor:'running'!
debug
-
-"/ self signalUnavailableResources.
-"/ [(self class selector: testSelector) runCase]
-"/ sunitEnsure: [self resources do: [:each | each reset]]
- self debugUsing:#runCase.
+ [(self class selector: testSelector) runCase]
+ sunitEnsure: [TestResource resetResources: self resources].
!
debugAsFailure
- |semaphore|
-
- self signalUnavailableResources.
- semaphore := Semaphore new.
- [
- semaphore wait.
- self resources do:[:each |
- each reset
- ]
- ] fork.
-
- "/ used to be:
- "/ (self class selector:testSelector) runCaseAsFailure:semaphore
- "/ which is bad for subclasses which need more arguments.
- "/ why not use:
- "/ self copy perform:aSymbol
- "/ or even
- "/ self perform:aSymbol
- "/ (self class selector:testSelector) runCaseAsFailure:semaphore.
- self runCaseAsFailure:semaphore
+ | semaphore |
+ semaphore := Semaphore new.
+ [semaphore wait. TestResource resetResources: self resources] fork.
+ (self class selector: testSelector) runCaseAsFailure: semaphore.
!
-debugUsing:aSymbol
+debugUsing:aSymbol
self signalUnavailableResources.
[
- "/ used to be:
- "/ (self class selector:testSelector) perform:aSymbol
- "/ which is bad for subclasses which need more arguments.
- "/ why not use:
- "/ self copy perform:aSymbol
- "/ or even
- "/ self perform:aSymbol
- "/ (self class selector:testSelector) perform:aSymbol
- self perform:aSymbol
+ "/ used to be:
+ "/ (self class selector:testSelector) perform:aSymbol
+ "/ which is bad for subclasses which need more arguments.
+ "/ why not use:
+ "/ self copy perform:aSymbol
+ "/ or even
+ "/ self perform:aSymbol
+ "/ (self class selector:testSelector) perform:aSymbol
+ self perform:aSymbol
] ensure:[
- self resources do:[:each |
- each reset
- ]
+ self resources do:[:each |
+ each reset
+ ]
]
@@ -705,106 +652,101 @@
!
-failureLog
- ^SUnitNameResolver class >> #defaultLogDevice
+failureLog
+ ^SUnitNameResolver class >> #defaultLogDevice
!
isLogging
- "By default, we're not logging failures. If you override this in
+ "By default, we're not logging failures. If you override this in
a subclass, make sure that you override #failureLog"
^false
-
+
!
logFailure: aString
self isLogging ifTrue: [
- self failureLog
- cr;
- nextPutAll: aString;
+ self failureLog
+ cr;
+ nextPutAll: aString;
flush]
-
+
!
openDebuggerOnFailingTestMethod
- "SUnit has halted one step in front of the failing test method. Step over the 'self halt' and
- send into 'self perform: testSelector' to see the failure from the beginning"
+ "SUnit has halted one step in front of the failing test method. Step over the 'self halt' and
+ send into 'self perform: testSelector' to see the failure from the beginning"
- self
- "halt;"
- performTest
+ self
+ "/halt;
+ performTest
+
+ "Modified: / 05-12-2009 / 18:40:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
run
| result |
result := TestResult new.
- self run: result.
+ [self run: result]
+ sunitEnsure: [TestResource resetResources: self resources].
^result
-
!
run: aResult
aResult runCase: self
-
!
run: aResult afterEachDo:block2
- aResult runCase: self.
- block2 value:self value:aResult.
+ aResult runCase: self.
+ block2 value:self value:aResult.
!
run: aResult beforeEachDo:block1 afterEachDo:block2
- block1 value:self value:aResult.
- aResult runCase: self.
- block2 value:self value:aResult.
+ block1 value:self value:aResult.
+ aResult runCase: self.
+ block2 value:self value:aResult.
!
run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
- block1 value:self value:aResult.
- aResult runCase: self.
- block2 value:self value:aResult.
+ block1 value:self value:aResult.
+ aResult runCase: self.
+ block2 value:self value:aResult.
!
runCase
- [
- self setUp.
- self performTest
- ] ensure:[
- Error , AbortOperationRequest
- handle:[:ex |
- ex signal ~~ AbortOperationRequest ifTrue:[
- Transcript showCR:'Error during tearDown: "', ex description, '" - ignored'.
- ]
- ]
- do:[ self tearDown ]
- ]
+ self resources do: [:each | each availableFor: self].
+ [self setUp.
+ self performTest] sunitEnsure: [self tearDown]
!
runCaseAsFailure
- self setUp.
- [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
+ self setUp.
+ [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
"Modified: / 21.6.2000 / 10:04:33 / Sames"
!
runCaseAsFailure: aSemaphore
- [self setUp.
- self openDebuggerOnFailingTestMethod] ensure: [
- self tearDown.
- aSemaphore signal]
+ [self resources do: [:each | each availableFor: self].
+ [self setUp.
+ self openDebuggerOnFailingTestMethod]
+ sunitEnsure: [self tearDown]]
+ sunitEnsure: [aSemaphore signal].
!
setUp
-
!
tearDown
-
! !
!TestCase class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.57 2011-06-29 18:38:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.58 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestCase.st 218 2011-06-13 15:45:06Z vranyj1 §'
! !
TestCase initialize!
--- a/TestCaseWithArguments.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestCaseWithArguments.st Wed Jun 29 21:15:49 2011 +0200
@@ -15,28 +15,28 @@
To do so, redefine buildAdditionalTestsInSuite:suite,
to add more tests by sending
- addTest:(self testSelector: testArguments )
+ addTest:(self testSelector: testArguments )
Useful, if you want to evaluate a suites-test method on each file in some directory,
but still want to see the results as individual runs (to allow for a rerun-defects)
[author:]
- cg@exept.de
+ cg@exept.de
"
! !
!TestCaseWithArguments class methodsFor:'instance creation'!
selector: aSymbol argument: arg
- ^self new
- setTestSelector: aSymbol
- setTestArguments: (Array with:arg)
+ ^self new
+ setTestSelector: aSymbol
+ setTestArguments: (Array with:arg)
!
selector: aSymbol arguments: args
- ^self new
- setTestSelector: aSymbol
- setTestArguments: args
+ ^self new
+ setTestSelector: aSymbol
+ setTestArguments: args
! !
!TestCaseWithArguments class methodsFor:'building suites'!
@@ -64,56 +64,43 @@
!TestCaseWithArguments methodsFor:'printing'!
-printOn: aStream
- aStream nextPutAll: self name.
- aStream nextPutAll: '>>'.
- testSelector printOn: aStream.
- testSelector numArgs > 0 ifTrue:[
- aStream nextPutAll: ' ('.
- testArguments printOn: aStream.
- aStream nextPutAll: ')'.
- ].
+getTestName
+ testArguments isEmptyOrNil ifTrue:[^testSelector].
+ ^testSelector , '(' , testArguments first printString , ')'.
!
-testName
- testArguments isEmptyOrNil ifTrue:[^ testSelector].
-
- ^ testSelector,'(',testArguments first printString,')'.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+printOn: aStream
+ aStream nextPutAll: self name.
+ aStream nextPutAll: '>>'.
+ testSelector printOn: aStream.
+ testSelector numArgs > 0 ifTrue:[
+ aStream nextPutAll: ' ('.
+ testArguments printOn: aStream.
+ aStream nextPutAll: ')'.
+ ].
! !
!TestCaseWithArguments methodsFor:'private'!
performTest
- self perform:(testSelector asSymbol) withArguments:(testArguments)
+ self perform:(testSelector asSymbol) withArguments:(testArguments)
!
setTestSelector:aSymbol setTestArguments: args
- testSelector := aSymbol.
+ testSelector := aSymbol.
testArguments := args
! !
!TestCaseWithArguments class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCaseWithArguments.st,v 1.4 2009-10-03 13:27:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCaseWithArguments.st,v 1.5 2011-06-29 19:15:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCaseWithArguments.st,v 1.4 2009-10-03 13:27:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCaseWithArguments.st,v 1.5 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestCaseWithArguments.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/TestFailure.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestFailure.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,6 +7,22 @@
category:'SUnit-Preload'
!
+!TestFailure class methodsFor:'documentation'!
+
+documentation
+"
+ 'TestFailure is raised when the boolean parameter of an assert: ... or deny: ... call is the opposite of what the assertion claims.
+
+
+"
+! !
+
+!TestFailure methodsFor:'Camp Smalltalk'!
+
+sunitAnnounce: aTestCase toResult: aTestResult
+ aTestResult addFailure: aTestCase.
+ self sunitExitWith: false.
+! !
!TestFailure methodsFor:'handling'!
@@ -19,5 +35,9 @@
!TestFailure class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestFailure.st,v 1.5 2003-09-26 15:55:54 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestFailure.st,v 1.6 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestFailure.st 204 2010-09-11 15:21:51Z vranyj1 §'
! !
--- a/TestResource.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestResource.st Wed Jun 29 21:15:49 2011 +0200
@@ -1,6 +1,6 @@
"{ Package: 'stx:goodies/sunit' }"
-Object subclass:#TestResource
+TestAsserter subclass:#TestResource
instanceVariableNames:'name description'
classVariableNames:''
poolDictionaries:''
@@ -14,67 +14,139 @@
"
!
+TestResource comment:'Normally a test will set up all the objects it needs and tear them down again after it has run. This self-containedness makes a test more robust. Use TestResources only for objects that are needed by several tests and that are too ''expensive'' (in time or otherwise) to recreate and destroy for each test. A viable approach is to develop the code in MyTestCase''s #setUp and #tearDown methods, then at some point refactor the code into the #setUp and #tearDown of a TestResource whose class is added to MyTestCase class>>resource method.
+
+TestResource uses the singleton pattern. A TestResource class will set up a single instance of itself when first requested and tear it down again at the end of TestSuite>>run (or TestCase>>run, >>debug and >>debugAsFailure). Normally, a TestResource, once setUp, remains active during the running of all remaining tests and is #reset after all tests have run. For an exception, see subclass CompetingResource in SUnitResourcePatterns. Users can choose to #reset a resource in the #tearDown of a test that alters it, sacrificing the performance gain of having a single #setUp of the resource for the certainty that other tests using it will not see the alterations. Generally however, this should be the exception: if you need to reset the resource for every test that uses it, its code should just be part of your test''s #setUp and #tearDown code.
+
+To use, create a subclass of TestResource and override the following:
+ - TestCase class>>resources, to return a collection including the TestResource class, for all test case classes that need it
+ * a TestCase'' resources are set up in the order returned and torn down in the reverse order
+ - TestResource class>>resources, if the resource itself always needs some other resource to be present before it can set up
+ * a TestResource''s resource are set up before it and torn down after it, and are set up in the order returned and torn down in the reverse order
+ - TestResource>>setUp and tearDown, to define initial and final behaviour (just like a test)
+ - TestResource>>isAvailable, to return true if it is and false if it isn''t (the framework calls this after setUp); ideally, this call should not change the resource'' state - that should be done in setUp
+
+TestResource implements the singleton pattern in its class-side #isAvailable and #reset methods. Do not override these when creating specific resources; unless you are developing a whole new pattern of use, it will always be correct to override instance-side #setUp, #tearDown and #isAvailable, and dangerous to override class>>isAvailable, class>>isAlreadyAvailable and class>>reset.
+
+Generally, users do not code interactions with a test''s resources during the running of a test. Code that reads a resource'' values while leaving its state strictly alone is safe enough. A test must leave a resource in a clean state: always use #reset if a test must protect later-running tests from unsafe changes (and review whether in such a case a resource is the right thing to use in the first place).
+
+See my superclass'' comment for assertion and logging information.
+'
+!
+
+
+!TestResource class methodsFor:'instance creation'!
+
+new
+ "Use #current to get the valid current instance. Use of #new to get an instance (that should never be the current one) could be done in bizarre circumstances, so is not blocked, but will usually be inappropriate."
+
+ ^super new initialize
+!
+
+reset
+ [self isAlreadyAvailable ifTrue: [current tearDown]]
+ sunitEnsure: [current := nil].
+! !
!TestResource class methodsFor:'accessing'!
current
+ "This is a lazy accessor: the assert of self isAvailable does no work unless current isNil. However this method should normally be sent only to a resource that should already have been made available, e.g. in a test whose test case class has the resource class in its #resources, so should never be able to fail the assert.
+ If the intent is indeed to access a possibly-unprepared or reset-in-earlier-test resource lazily, then preface the call of 'MyResource current' with 'MyResource availableFor: self'."
- current isNil
- ifTrue: [current := self new].
-
+ self assert: self isAvailable
+ description: 'Sent #current to unavailable resource ', self name, '. Add it to test case'' class-side #resources (recommended) or send #availableFor: beforehand'.
^current
-
!
current: aTestResource
current := aTestResource
-
+
!
resources
^#()
-
! !
!TestResource class methodsFor:'creation'!
-new
+signalInitializationError
+ ^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
+
+! !
+
+!TestResource class methodsFor:'private'!
- ^self basicNew initialize
+makeAvailable
+ "This method must be the _only_ way to set a notNil value for the unique instance (current). First, obtain a candidate instance and set current to a notNil placeholder (any notNil object not an instance of me would do; this version uses false). Next, check any subordinate resources needed by this resource. Lastly, setUp the candidate and put it in current if it is available, ensuring that it is torn down otherwise."
+
+ | candidate |
+ current := false.
+ candidate := self new.
+ self resources do: [:each | each availableFor: candidate].
+ [candidate setUp.
+ candidate isAvailable ifTrue: [current := candidate]]
+ sunitEnsure: [current == candidate ifFalse: [candidate tearDown]].
!
-reset
+resetOrAddResourcesTo: aCollection
+ "Add correctly set-up resources to the collection unless already there. Reset any imperfectly-set-up resources, so current isNil will return true if they are re-encountered via an indirectly self-prerequing resource; circular references cannot be set up so will never reply true to isAlreadyAvailable, but may have correctly-set-up prereqs to add and/or imperfectly-set-up ones to reset, so do not abort the loop first time round."
- current notNil ifTrue: [
- [current tearDown] ensure: [
- current := nil]]
-
+ current isNil ifTrue: [^self].
+ self isAlreadyAvailable
+ ifFalse:
+ [self reset.
+ self resources do: [:each | each resetOrAddResourcesTo: aCollection]]
+ ifTrue:
+ [(aCollection includes: self) ifFalse:
+ [self resources do: [:each | each resetOrAddResourcesTo: aCollection].
+ aCollection add: self]].
+
+"The cloned 'self resources do: ...' line in both blocks is, I think, the best way to write this method so that its logic is clear. The first loop resets this resource immediately, before traversing its resources; the second traverses before adding"
+! !
+
+!TestResource class methodsFor:'running'!
+
+availableFor: aTestAsserter
+ aTestAsserter
+ assert: self isAvailable
+ description: 'Unavailable resource ' , self name , ' requested by ', aTestAsserter printString.
!
-signalInitializationError
- ^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
-
+resetResources: topLevelResources
+ "Reset all imperfectly-set-up resources while gathering the rest for ordered resetting."
+
+ | availableResources |
+ availableResources := OrderedCollection new: topLevelResources size.
+ topLevelResources do: [:each | each resetOrAddResourcesTo: availableResources].
+ availableResources reverseDo: [:each | each reset].
! !
!TestResource class methodsFor:'testing'!
isAbstract
- "Override to true if a TestResource subclass is Abstract and should not have
- TestCase instances built from it"
+ "Override to true if a TestResource subclass is Abstract and should not have
+ TestCase instances built from it"
- ^ self == TestResource
+ ^ self == TestResource
+!
+
+isAlreadyAvailable
+ ^current class == self
!
isAvailable
- ^self current notNil and: [self current isAvailable]
-
+ "This is (and must be) a lazy method. If my current has a value, an attempt to make me available has already been made: trust its result. If not, try to make me available."
+
+ current isNil ifTrue: [self makeAvailable].
+ ^self isAlreadyAvailable
!
isUnavailable
^self isAvailable not
-
+
! !
!TestResource methodsFor:'accessing'!
@@ -85,13 +157,11 @@
ifTrue: [^''].
^description
-
!
description: aString
description := aString
-
!
name
@@ -100,26 +170,25 @@
ifTrue: [^self printString].
^name
-
!
name: aString
name := aString
-
!
resources
^self class resources
-
! !
-!TestResource methodsFor:'init / release'!
+!TestResource methodsFor:'initialize-release'!
initialize
- self setUp
+ "This method used to call setUp but now does nothing; setUp is called by the framework at the appropriate point. Subclasses may override to set the object to its default state."
+!
-
+uninitialize
+ self tearDown.
! !
!TestResource methodsFor:'printing'!
@@ -127,52 +196,45 @@
printOn: aStream
aStream nextPutAll: self class printString
-
! !
!TestResource methodsFor:'running'!
setUp
- "Does nothing. Subclasses should override this
- to initialize their resource"
-
+ "Does nothing. Subclasses should override this to initialize their resource"
!
signalInitializationError
^self class signalInitializationError
-
+
!
tearDown
- "Does nothing. Subclasses should override this
- to tear down their resource"
-
+ "Does nothing. Subclasses should override this to tear down their resource"
! !
!TestResource methodsFor:'testing'!
isAvailable
- "override to provide information on the
- readiness of the resource"
-
+ "Override to provide information on the readiness of the resource. Put state-changing behaviour in setUp and keep this a state-preserving check as far as possible. Where setUp is guaranteed to provide a valid resource if it completes, there is no need to override this."
+
^true
-
!
isUnavailable
"override to provide information on the
readiness of the resource"
-
+
^self isAvailable not
-
+
! !
!TestResource class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResource.st,v 1.6 2010-06-14 11:01:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResource.st,v 1.7 2011-06-29 19:15:49 cg Exp $'
!
-version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResource.st,v 1.6 2010-06-14 11:01:11 cg Exp $'
+version_SVN
+ ^ '§Id: TestResource.st 204 2010-09-11 15:21:51Z vranyj1 §'
! !
--- a/TestResult.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestResult.st Wed Jun 29 21:15:49 2011 +0200
@@ -1,119 +1,99 @@
"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestResult
- instanceVariableNames:'failures errors passed'
+ instanceVariableNames:'name timestamp failures errors passed'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
-TestResult comment:'This is a Collecting Parameter for the running of a bunch of tests. TestResult is an interesting object to subclass or substitute. #runCase: is the external protocol you need to reproduce. Kent has seen TestResults that recorded coverage information and that sent email when they were done.'
+TestResult comment:''
!
+!TestResult class methodsFor:'instance creation'!
+
+new
+ ^super new initialize
+! !
+
!TestResult class methodsFor:'exceptions'!
error
^self exError
-
!
exError
^SUnitNameResolver errorObject
-
!
failure
^TestFailure
-
!
resumableFailure
^ResumableTestFailure
-
-!
-
-signalErrorWith: aString
-
-"/ self error sunitSignalWith: aString
- self exError raiseErrorString: aString
!
-signalFailureWith: aString
-
-"/ self failure sunitSignalWith: aString
- self failure raiseErrorString: aString
-! !
+signalErrorWith: aString
+ self error sunitSignalWith: aString
+!
-!TestResult class methodsFor:'initialization & release'!
-
-new
- ^super new initialize
-
+signalFailureWith: aString
+ self failure sunitSignalWith: aString
! !
!TestResult methodsFor:'accessing'!
-correctCount
- "depreciated - use #passedCount"
-
- ^self passedCount
-
-!
-
defects
^OrderedCollection new
addAll: self errors;
addAll: self failures; yourself
-
!
errorCount
^self errors size
-
!
errors
-
- errors isNil
- ifTrue: [errors := OrderedCollection new].
+ errors isNil ifTrue: [errors := OrderedCollection new].
^errors
-
!
failureCount
^self failures size
-
!
failures
- failures isNil
- ifTrue: [failures := Set new].
+ "We use a Set, not an OrderedCollection as #errors and #passed do, because a resumable test failure in a loop can raise many failures against the same test. In current Sunit UIs, this could result in bizarre test count reporting (-27 tests run, and suchlike). This will be reviewed."
+
+ failures isNil ifTrue: [failures := Set new].
^failures
-
+!
+
+name
+ ^ name
+!
+
+name:aString
+ name := aString.
!
passed
-
- passed isNil
- ifTrue: [passed := OrderedCollection new].
-
+ passed isNil ifTrue: [passed := OrderedCollection new].
^passed
-
!
passedCount
^self passed size
-
!
runCount
^self passedCount + self failureCount + self errorCount
-
!
tests
@@ -123,13 +103,46 @@
addAll: self errors;
addAll: self failures;
yourself
-
+!
+
+timestamp
+ ^ timestamp
! !
-!TestResult methodsFor:'init / release'!
+!TestResult methodsFor:'adding'!
+
+addError: aTestCase
+ aTestCase class rememberErrorTest: aTestCase selector.
+ ^self errors add: aTestCase
+
+ "Modified: / 11-09-2010 / 17:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addFailure: aTestCase
+ aTestCase class rememberFailedTest: aTestCase selector.
+ ^self failures add: aTestCase
+
+ "Modified: / 11-09-2010 / 17:18:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addPass: aTestCase
+ aTestCase class rememberPassedTest: aTestCase selector.
+ ^self passed add: aTestCase
+
+ "Modified: / 11-09-2010 / 17:19:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestResult methodsFor:'deprecated'!
+
+correctCount
+ "deprecated - use #passedCount"
+
+ ^self passedCount
+! !
+
+!TestResult methodsFor:'initialize-release'!
initialize
-
! !
!TestResult methodsFor:'printing'!
@@ -148,57 +161,15 @@
self errorCount ~= 1
ifTrue: [aStream nextPut: $s]
-
! !
!TestResult methodsFor:'running'!
-runCase:aTestCase
- |testCasePassed failure error|
-
- testCasePassed := true.
- failure := error := false.
-
- [
- [
- aTestCase runCase.
-
- ] on:self class failure do:[:ex |
- testCasePassed ifTrue:
- [failure := true.
- testCasePassed := false].
-
- ex handleFailureWith:false
- ]
- ] on:self class error do:[:ex |
- (AbortAllOperationRequest accepts:ex signal) ifTrue:[
- (AbortOperationRequest accepts:ex signal) ifFalse:[
- ex reject
- ].
- ].
- (HaltInterrupt accepts:ex signal) ifTrue:[
- ex reject
- ].
- error := true.
- testCasePassed := false.
- ex returnWith:false
- ].
-
- error
- ifTrue:
- [self errors add: aTestCase]
- ifFalse:
- [failure ifTrue: [self failures add: aTestCase]].
-
- testCasePassed ifTrue:[
- self passed add:aTestCase
- ]
-
- "Modified: / 06-08-2006 / 10:42:42 / cg"
- "Modified: / 28-08-2006 / 16:40:00 / boris"
-
- " a test case should be registered either as passed or as failed or as error.
- Note that several resumable failures may preceed one final error "
+runCase: aTestCase
+ [aTestCase runCase.
+ self addPass: aTestCase]
+ sunitOn: self class failure , self class error
+ do: [:ex | ex sunitAnnounce: aTestCase toResult: self].
! !
!TestResult methodsFor:'testing'!
@@ -206,40 +177,38 @@
hasErrors
^self errors size > 0
-
!
hasFailures
^self failures size > 0
-
!
hasPassed
^self hasErrors not and: [self hasFailures not]
-
!
isError: aTestCase
^self errors includes: aTestCase
-
!
isFailure: aTestCase
^self failures includes: aTestCase
-
!
isPassed: aTestCase
^self passed includes: aTestCase
-
! !
!TestResult class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.19 2008-09-03 08:50:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.20 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestResult.st 205 2010-09-11 15:23:01Z vranyj1 §'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestResultReporter.st Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,145 @@
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestResultReporter
+ instanceVariableNames:'result stream'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit-Report'
+!
+
+
+!TestResultReporter class methodsFor:'reporting'!
+
+report: aTestResult format: format as: stringOrFilename
+
+ self new report: aTestResult format: format as: stringOrFilename
+!
+
+report: aTestResult format: format on: stream
+
+ self new report: aTestResult format: format on: stream
+! !
+
+!TestResultReporter methodsFor:'reporting'!
+
+report:format
+ |reportFormatSelector|
+
+ reportFormatSelector := self reportFormatSelector:format.
+ (self respondsTo: reportFormatSelector)
+ ifTrue:[self perform: reportFormatSelector]
+ ifFalse:[self error:'Unsupported format: ', format].
+!
+
+report: aTestResult format: format as: stringOrFilename
+
+ | s |
+ s := stringOrFilename asFilename writeStream.
+ [ self report: aTestResult format: format on: s]
+ ensure:[s close].
+!
+
+report: aTestResult format: aSymbol on: aStream
+
+ result := aTestResult.
+ stream := aStream.
+ self report: aSymbol
+!
+
+reportFormatSelector:format
+ ^ ('report' , format asString capitalized) asSymbol
+! !
+
+!TestResultReporter methodsFor:'reporting - xml'!
+
+reportXml
+
+ "JUnit like XML unittest report format"
+
+ stream
+ nextPutLine: '<?xml version="1.0"?>';
+ nextPutLine: '<unittest-results>'.
+
+ result passed do:[:each|self reportXmlTest: each result: #success].
+ result failures do:[:each|self reportXmlTest: each result: #failure].
+ result errors do:[:each|self reportXmlTest: each result: #error].
+
+ stream
+ nextPutLine: '</unittest-results>'
+!
+
+reportXmlTest: test result: testResult
+
+ "
+ Example:
+ <test
+ duration='0.0188629627228'
+ status='error'
+ fixture='bitten.tests.web_ui.SourceFileLinkFormatterTestCase'
+ name='test_format_link_not_in_repos_with_line'
+ file='/usr/src/trac-bitten-0.6b2.dfsg/bitten/tests/web_ui.py'>
+ "
+
+ | testClassName |
+ testClassName := self sunitNameOf: test class.
+
+ stream
+ nextPutLine:'<test duration="0.0"'; "As we don't know the duration :-("
+ tab; nextPutAll:'status="'; nextPutAll: testResult; nextPutLine:'"';
+ tab; nextPutAll:'ficture="'; nextPutAll: testClassName; nextPutLine:'"';
+ tab; nextPutAll:'name="'; nextPutAll: test selector; nextPutLine:'"';
+ "I seems that some tools requires the file attributes. So we supply one :-)"
+ tab; nextPutAll:'file="'; nextPutAll: testClassName , '.st'; nextPutLine:'">'.
+
+ testResult ~= #success ifTrue:[self reportXmlTraceback: test].
+
+ stream nextPutLine:'</test>'.
+!
+
+reportXmlTraceback: test
+
+ "
+ Prints a traceback to the stream.
+ This is dialect-specific, so we have to check...
+ "
+
+ "Smalltalk/X dialect detection..."
+ ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX])
+ ifTrue:[^self reportXmlTracebackStX: test]
+!
+
+reportXmlTracebackStX: test
+
+ stream nextPutLine:'<traceback><!![CDATA['.
+
+ [ test debug ]
+ on: GenericException
+ do: [:ex|
+ ex suspendedContext fullPrintAllOn: stream].
+
+ stream nextPutLine:']]></traceback>'.
+
+ "Modified: / 07-12-2009 / 14:06:48 / Jan Vrany <jan.vrant@fit.cvut.cz>"
+! !
+
+!TestResultReporter methodsFor:'utilities'!
+
+sunitNameOf: aClass
+
+ "No all SUnit versions comes with sunitName
+ (at least Smalltalk/X 3.1)"
+
+ ^(aClass respondsTo:#sunitName)
+ ifTrue:[aClass sunitName]
+ ifFalse:[aClass printString]
+! !
+
+!TestResultReporter class methodsFor:'documentation'!
+
+version
+ ^ '$Id: TestResultReporter.st,v 1.1 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id§'
+! !
--- a/TestRunner.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestRunner.st Wed Jun 29 21:15:49 2011 +0200
@@ -13,12 +13,12 @@
documentation
"
- This GUI is based on SUnit2.7 and
+ This GUI is based on SUnit2.7 and
was ported to ST/X by Samuel S. Schuster (as 2.7) (thanks, indeed)
It was slightly enhanced by adding a rerun-defects, browse and
a category selector (to minor revision 2.7d, in the meantime)
-"
+"
! !
!TestRunner class methodsFor:'defaults'!
@@ -90,129 +90,129 @@
<resource: #canvas>
- ^
+ ^
#(FullSpec
- name: windowSpec
- window:
+ name: windowSpec
+ window:
(WindowSpec
- label: 'SUnit Camp Smalltalk 3.1/STX TestRunner'
- name: 'SUnit Camp Smalltalk 3.1/STX TestRunner'
- min: (Point 362 122)
- bounds: (Rectangle 0 0 493 175)
- icon: defaultIcon
- )
- component:
+ label: 'SUnit Camp Smalltalk 3.1/STX TestRunner'
+ name: 'SUnit Camp Smalltalk 3.1/STX TestRunner'
+ min: (Point 362 122)
+ bounds: (Rectangle 0 0 493 175)
+ icon: defaultIcon
+ )
+ component:
(SpecCollection
- collection: (
- (ActionButtonSpec
- label: 'Refresh'
- name: 'RefreshButton'
- layout: (LayoutFrame 0 0 0 0 75 0 48 0)
- activeHelpKey: refreshSuitesButton
- tabable: true
- model: refreshSuites
- )
- (MenuButtonSpec
- name: 'category'
- layout: (LayoutFrame 76 0 0 0 -216 1 24 0)
- activeHelpKey: suitesCategoryList
- tabable: true
- model: category
- menu: categoryList
- )
- (MenuButtonSpec
- name: tests
- layout: (LayoutFrame 76 0 24 0 -216 1 48 0)
- activeHelpKey: suiteSelection
- tabable: true
- model: script
- menu: scriptModel
- useIndex: true
- )
- (ActionButtonSpec
- label: 'Run'
- name: 'RunButton'
- layout: (LayoutFrame -215 1 0 0 -160 1 48 0)
- activeHelpKey: runButton
- tabable: true
- model: runTests
- enableChannel: enableRunButton
- )
- (ActionButtonSpec
- label: 'ReRun Defects'
- name: 'ReRunButton'
- layout: (LayoutFrame -159 1 0 0 -57 1 48 0)
- activeHelpKey: rerunDefectsButton
- tabable: true
- model: runDefects
- enableChannel: enableDefects
- )
- (ActionButtonSpec
- label: 'Run All'
- name: 'RunAllButton'
- layout: (LayoutFrame -56 1 0 0 0 1 48 0)
- activeHelpKey: runAllButton
- tabable: true
- model: runAllTests
- )
- (ProgressIndicatorSpec
- name: 'ProgressIndicator1'
- layout: (LayoutFrame 0 0.0 49 0 0 1.0 60 0)
- visibilityChannel: percentageIndicatorVisible
- model: percentageDone
- foregroundColor: (Color 32.999160753796 32.999160753796 0.0)
- backgroundColor: (Color 66.999313344015 66.999313344015 0.0)
- showPercentage: false
- )
- (LabelSpec
- label: '...'
- name: 'details'
- layout: (LayoutFrame 0 0 21 0.5 0 1 -25 1)
- labelChannel: details
- )
- (LabelSpec
- label: 'N/A'
- name: 'mode'
- layout: (LayoutFrame 0 0 49 0 0 1 35 0.5)
- style: (FontDescription Arial bold roman 14)
- labelChannel: mode
- )
- (MenuButtonSpec
- name: defects
- layout: (LayoutFrame 0 0 -24 1 -152 1 0 1)
- isOpaque: true
- flags: 40
- activeHelpKey: defectsList
- tabable: true
- model: selectionHolder
- initiallyDisabled: true
- enableChannel: enableDefects
- menu: defectMenu
- ignoreReselect: false
- )
- (ActionButtonSpec
- label: 'Browse'
- name: 'BrowseButton'
- layout: (LayoutFrame -151 1 -24 1 -76 1 0 1)
- activeHelpKey: browseButton
- tabable: true
- model: browseSelectedTestCase
- initiallyDisabled: true
- enableChannel: enableRunButton
- )
- (ActionButtonSpec
- label: 'Debug'
- name: 'DebugButton'
- layout: (LayoutFrame -75 1 -24 1 0 1 0 1)
- activeHelpKey: debugButton
- tabable: true
- model: debugSelectedFailure
- initiallyDisabled: true
- enableChannel: enableDebugButton
- )
- )
-
- )
+ collection: (
+ (ActionButtonSpec
+ label: 'Refresh'
+ name: 'RefreshButton'
+ layout: (LayoutFrame 0 0 0 0 75 0 48 0)
+ activeHelpKey: refreshSuitesButton
+ tabable: true
+ model: refreshSuites
+ )
+ (MenuButtonSpec
+ name: 'category'
+ layout: (LayoutFrame 76 0 0 0 -216 1 24 0)
+ activeHelpKey: suitesCategoryList
+ tabable: true
+ model: category
+ menu: categoryList
+ )
+ (MenuButtonSpec
+ name: tests
+ layout: (LayoutFrame 76 0 24 0 -216 1 48 0)
+ activeHelpKey: suiteSelection
+ tabable: true
+ model: script
+ menu: scriptModel
+ useIndex: true
+ )
+ (ActionButtonSpec
+ label: 'Run'
+ name: 'RunButton'
+ layout: (LayoutFrame -215 1 0 0 -160 1 48 0)
+ activeHelpKey: runButton
+ tabable: true
+ model: runTests
+ enableChannel: enableRunButton
+ )
+ (ActionButtonSpec
+ label: 'ReRun Defects'
+ name: 'ReRunButton'
+ layout: (LayoutFrame -159 1 0 0 -57 1 48 0)
+ activeHelpKey: rerunDefectsButton
+ tabable: true
+ model: runDefects
+ enableChannel: enableDefects
+ )
+ (ActionButtonSpec
+ label: 'Run All'
+ name: 'RunAllButton'
+ layout: (LayoutFrame -56 1 0 0 0 1 48 0)
+ activeHelpKey: runAllButton
+ tabable: true
+ model: runAllTests
+ )
+ (ProgressIndicatorSpec
+ name: 'ProgressIndicator1'
+ layout: (LayoutFrame 0 0.0 49 0 0 1.0 60 0)
+ visibilityChannel: percentageIndicatorVisible
+ model: percentageDone
+ foregroundColor: (Color 32.999160753796 32.999160753796 0.0)
+ backgroundColor: (Color 66.999313344015 66.999313344015 0.0)
+ showPercentage: false
+ )
+ (LabelSpec
+ label: '...'
+ name: 'details'
+ layout: (LayoutFrame 0 0 21 0.5 0 1 -25 1)
+ labelChannel: details
+ )
+ (LabelSpec
+ label: 'N/A'
+ name: 'mode'
+ layout: (LayoutFrame 0 0 49 0 0 1 35 0.5)
+ style: (FontDescription Arial bold roman 14)
+ labelChannel: mode
+ )
+ (MenuButtonSpec
+ name: defects
+ layout: (LayoutFrame 0 0 -24 1 -152 1 0 1)
+ isOpaque: true
+ flags: 40
+ activeHelpKey: defectsList
+ tabable: true
+ model: selectionHolder
+ initiallyDisabled: true
+ enableChannel: enableDefects
+ menu: defectMenu
+ ignoreReselect: false
+ )
+ (ActionButtonSpec
+ label: 'Browse'
+ name: 'BrowseButton'
+ layout: (LayoutFrame -151 1 -24 1 -76 1 0 1)
+ activeHelpKey: browseButton
+ tabable: true
+ model: browseSelectedTestCase
+ initiallyDisabled: true
+ enableChannel: enableRunButton
+ )
+ (ActionButtonSpec
+ label: 'Debug'
+ name: 'DebugButton'
+ layout: (LayoutFrame -75 1 -24 1 0 1 0 1)
+ activeHelpKey: debugButton
+ tabable: true
+ model: debugSelectedFailure
+ initiallyDisabled: true
+ enableChannel: enableDebugButton
+ )
+ )
+
+ )
)
! !
@@ -238,7 +238,7 @@
"/ in oder for CTRL-C and busyCursor to work correctly.
"/ Therefore, push event instead of executing the test here.
- "/runner runTests
+ "/runner runTests
runner enqueueMessage:#runTests for:runner arguments:#().
"
@@ -261,7 +261,7 @@
(if this app is embedded in a subCanvas)."
^ #(
- #script
+ #script
).
! !
@@ -272,17 +272,17 @@
|holder|
(holder := builder bindingAt:#category) isNil ifTrue:[
- holder := '* all *' asValue.
- builder aspectAt:#category put:holder.
- holder onChangeSend:#categorySelectionChanged to:self.
+ holder := '* all *' asValue.
+ builder aspectAt:#category put:holder.
+ holder onChangeSend:#categorySelectionChanged to:self.
].
^ holder.
!
categoryList
- ^categoryModel isNil
- ifTrue: [categoryModel := ValueHolder new. self updateCategoryList. categoryModel]
- ifFalse: [categoryModel]
+ ^categoryModel isNil
+ ifTrue: [categoryModel := ValueHolder new. self updateCategoryList. categoryModel]
+ ifFalse: [categoryModel]
!
defectMenu
@@ -292,7 +292,7 @@
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
- ^defectMenu isNil
+ ^defectMenu isNil
ifTrue: [defectMenu := OrderedCollection new asValue]
ifFalse: [defectMenu]
@@ -348,8 +348,8 @@
"*** Please change as required and accept it in the browser."
script isNil ifTrue:[
- script := ValueHolder new.
- script onChangeSend:#suiteSelectionChanged to:self.
+ script := ValueHolder new.
+ script onChangeSend:#suiteSelectionChanged to:self.
].
^ script.
@@ -378,13 +378,13 @@
scriptModel
"This method was generated by UIDefiner. Any edits made here
- may be lost whenever methods are automatically defined. The
- initialization provided below may have been preempted by an
- initialize method."
+ may be lost whenever methods are automatically defined. The
+ initialization provided below may have been preempted by an
+ initialize method."
- ^scriptModel isNil
- ifTrue: [scriptModel := ValueHolder new. self updateSuitesList. scriptModel]
- ifFalse: [scriptModel]
+ ^scriptModel isNil
+ ifTrue: [scriptModel := ValueHolder new. self updateSuitesList. scriptModel]
+ ifFalse: [scriptModel]
"Modified: / 2.4.2000 / 14:37:51 / Sames"
!
@@ -401,8 +401,8 @@
|holder|
(holder := builder bindingAt:#selectionHolder) isNil ifTrue:[
- holder := AspectAdaptor new subject:self; forAspect:#selection.
- builder aspectAt:#selectionHolder put:holder.
+ holder := AspectAdaptor new subject:self; forAspect:#selection.
+ builder aspectAt:#selectionHolder put:holder.
].
^ holder.
@@ -424,40 +424,40 @@
testCaseName := self selectedScript.
testCaseName isNil ifTrue:[
- testCaseName := self tests contents.
- testCaseName notNil ifTrue:[
- testCaseName := testCaseName string
- ]
+ testCaseName := self tests contents.
+ testCaseName notNil ifTrue:[
+ testCaseName := testCaseName string
+ ]
].
testCaseName notNil ifTrue:[
- testCase := Smalltalk at:testCaseName asSymbol.
- testCase notNil ifTrue:[
- browser := UserPreferences current systemBrowserClass openInClass:testCase.
- MessageNotUnderstood
- handle:[:ex | ]
- do:[
- (defect := self selection) notNil ifTrue:[
- singleCase := allDefects at:defect ifAbsent: [nil].
- ].
- singleCase notNil ifTrue:[
- browser switchToSelector:singleCase selector
- ] ifFalse:[
- browser selectProtocolsMatching:'test*'
- ]
- ]
- ]
+ testCase := Smalltalk at:testCaseName asSymbol.
+ testCase notNil ifTrue:[
+ browser := UserPreferences current systemBrowserClass openInClass:testCase.
+ MessageNotUnderstood
+ handle:[:ex | ]
+ do:[
+ (defect := self selection) notNil ifTrue:[
+ singleCase := allDefects at:defect ifAbsent: [nil].
+ ].
+ singleCase notNil ifTrue:[
+ browser switchToSelector:singleCase selector
+ ] ifFalse:[
+ browser selectProtocolsMatching:'test*'
+ ]
+ ]
+ ]
]
!
categorySelectionChanged
- |selectedScriptIndex selectedScript oldSuitesList newSuitesList
+ |selectedScriptIndex selectedScript oldSuitesList newSuitesList
newScriptSelectionIndex|
selectedScriptIndex := self script value.
oldSuitesList := self scriptModel value.
(selectedScriptIndex notNil and:[selectedScriptIndex ~~0]) ifTrue:[
- selectedScript := (oldSuitesList at:selectedScriptIndex) string
+ selectedScript := (oldSuitesList at:selectedScriptIndex) string
].
self updateSuitesList.
@@ -465,9 +465,9 @@
newSuitesList := self scriptModel value.
newScriptSelectionIndex := newSuitesList indexOf:selectedScript.
- self script value:(newScriptSelectionIndex == 0
- ifTrue:[nil]
- ifFalse:[newScriptSelectionIndex]).
+ self script value:(newScriptSelectionIndex == 0
+ ifTrue:[nil]
+ ifFalse:[newScriptSelectionIndex]).
!
debugSelectedFailure
@@ -477,7 +477,7 @@
"Modified: / 21.6.2000 / 12:21:05 / Sames"
!
-debugTest: aTestCaseName
+debugTest: aTestCaseName
| testCase |
defect := aTestCaseName.
@@ -490,9 +490,9 @@
"/ defect := nil.
self withWaitCursorDo:[
- ((result isFailure: testCase) "or:[(result isError: testCase)]")
- ifTrue: [testCase debugAsFailure]
- ifFalse: [testCase debug].
+ ((result isFailure: testCase) "or:[(result isError: testCase)]")
+ ifTrue: [testCase debugAsFailure]
+ ifFalse: [testCase debug].
].
"Modified: / 21.6.2000 / 12:12:09 / Sames"
@@ -516,15 +516,15 @@
!
refreshSuites
- self updateCategoryList.
- self updateSuitesList.
+ self updateCategoryList.
+ self updateSuitesList.
- self script value:nil.
- self tests selection: 0.
- self defects selection: 0.
- result := TestResult new.
- lastTestCase := nil.
- self displayRefresh
+ self script value:nil.
+ self tests selection: 0.
+ self defects selection: 0.
+ result := TestResult new.
+ lastTestCase := nil.
+ self displayRefresh
"Created: / 21.6.2000 / 10:58:34 / Sames"
"Modified: / 21.6.2000 / 12:19:54 / Sames"
@@ -551,73 +551,58 @@
self runTests
!
-runSuite: aTestSuite
- |numTests|
-
- "/ count the number of individual tests
- numTests := 0.
- aTestSuite tests do:[:eachTestOrSubSuite |
- (eachTestOrSubSuite isKindOf:TestSuite) ifTrue:[
- numTests := numTests + eachTestOrSubSuite tests size.
- ] ifFalse:[
- numTests := numTests + 1.
- ]
- ].
- numberOfTestsToRun := numTests.
- self percentageDone value:0.
+runSuite:aTestSuite
+ |numTests|
+ "/ count the number of individual tests
+ numTests := 0.
+ aTestSuite tests do:
+ [:eachTestOrSubSuite |
+ (eachTestOrSubSuite isKindOf:TestSuite)
+ ifTrue:[numTests := numTests + eachTestOrSubSuite tests size.]
+ ifFalse:[numTests := numTests + 1.]].
+ numberOfTestsToRun := numTests.
+ self percentageDone value:0.
+ Cursor wait showWhile:
+ [|errorCountBefore failureCountBefore|
+ self displayRunning.
- Cursor
- wait
- showWhile:[
- |errorCountBefore failureCountBefore|
+ "/ self displayDetails: '...'.
- self displayRunning.
- "/ self displayDetails: '...'.
- aTestSuite addDependentToHierachy: self.
- result := TestResult new.
- lastTestCase := aTestSuite.
- self showPercentageIndicator.
-
- errorCountBefore := result errorCount.
- failureCountBefore := result failureCount.
-
- [
- |caseName|
+ aTestSuite addDependentToHierachy:self.
+ result := TestResult new.
+ lastTestCase := aTestSuite.
+ self showPercentageIndicator.
+ errorCountBefore := result errorCount.
+ failureCountBefore := result failureCount.
- aTestSuite
- run:result
- beforeEachDo:[:eachCase :eachResult |
- caseName := eachCase testName.
- caseName size == 0 ifTrue:[self halt].
-
- self displayDetails:(caseName , '...').
- self testPassed:caseName
- ]
- afterEachDo:[:eachCase :eachResult |
- |passed errorCountAfter failureCountAfter|
-
- errorCountAfter := result errorCount.
- failureCountAfter := result failureCount.
- passed := (errorCountAfter == errorCountBefore)
- & (failureCountAfter == failureCountBefore).
-
- passed == true ifTrue:[
-"/ testsWhichPassed add:caseName.
-"/ testsWhichFailed remove:caseName ifAbsent:nil.
- ] ifFalse:[
- self testFailed:caseName withResult:result
- ].
- errorCountBefore := errorCountAfter.
- failureCountBefore := failureCountAfter
- ]
- ] ensure: [
- aTestSuite removeDependentFromHierachy: self.
- self hidePercentageIndicator.
- self displayNormalColorInProgress.
- ].
-
- self updateWindow
- ]
+ [|caseName|
+ aTestSuite
+ run:result
+ beforeEachDo:
+ [:eachCase :eachResult |
+ caseName := eachCase getTestName.
+ caseName size == 0 ifTrue:[self halt].
+ self displayDetails:(caseName , '...').
+ self testPassed:caseName]
+ afterEachDo:
+ [:eachCase :eachResult |
+ |passed errorCountAfter failureCountAfter|
+ errorCountAfter := result errorCount.
+ failureCountAfter := result failureCount.
+ passed := (errorCountAfter == errorCountBefore)
+ & (failureCountAfter == failureCountBefore).
+ passed == true
+ ifTrue:
+ ["/ testsWhichPassed add:caseName.
+ "/ testsWhichFailed remove:caseName ifAbsent:nil.
+ ]
+ ifFalse:[self testFailed:caseName withResult:result].
+ errorCountBefore := errorCountAfter.
+ failureCountBefore := failureCountAfter]] ensure:
+ [aTestSuite removeDependentFromHierachy:self.
+ self hidePercentageIndicator.
+ self displayNormalColorInProgress.].
+ self updateWindow]
!
runTests
@@ -635,9 +620,9 @@
selection: aValue
aValue = '' ifTrue:[
- defect := aValue.
+ defect := aValue.
] ifFalse:[
- self debugTest: aValue
+ self debugTest: aValue
].
"Created: / 4.4.2000 / 18:54:09 / Sames"
@@ -653,15 +638,15 @@
self enableDefects value:(ok and:[allDefects size > 0]).
self script value notNil ifTrue:[
- self selectedScript notNil ifTrue:[
- className := self selectedScript string.
- ].
- (ok and:[className notNil]) ifTrue:[
- cls := Smalltalk at:className.
- (cls class includesSelector:#description) ifTrue:[
- description := cls description.
- ]
- ].
+ self selectedScript notNil ifTrue:[
+ className := self selectedScript string.
+ ].
+ (ok and:[className notNil]) ifTrue:[
+ cls := Smalltalk at:className.
+ (cls class includesSelector:#description) ifTrue:[
+ description := cls description.
+ ]
+ ].
].
self displayDetails:nil.
self displayMode: (description ? '').
@@ -672,47 +657,47 @@
!
suitesInCategory
- |suites cat allCategories|
+ |suites cat allCategories|
- cat := self category value.
- allCategories := (cat = '* all *').
+ cat := self category value.
+ allCategories := (cat = '* all *').
- suites := TestCase allSubclasses
- select:[:each |
- true "/ "cg:TestCaseHelper is gone -->" ((each isSubclassOf:TestCaseHelper) not)
- and:[each isAbstract not
- and:[allCategories or:[cat = each category]]]]
- thenCollect: [:each | each name].
- suites sort.
- ^ suites
+ suites := TestCase allSubclasses
+ select:[:each |
+ true "/ "cg:TestCaseHelper is gone -->" ((each isSubclassOf:TestCaseHelper) not)
+ and:[each isAbstract not
+ and:[allCategories or:[cat = each category]]]]
+ thenCollect: [:each | each name].
+ suites sort.
+ ^ suites
!
updateCategoryList
- |categories|
+ |categories|
- categories := (TestCase allSubclasses collect: [:each | each category]) asSet asOrderedCollection.
- categories sort.
- categories addFirst:'* all *'.
- self categoryList value:categories.
+ categories := (TestCase allSubclasses collect: [:each | each category]) asSet asOrderedCollection.
+ categories sort.
+ categories addFirst:'* all *'.
+ self categoryList value:categories.
!
updateSuitesList
- |suites|
+ |suites|
- suites := self suitesInCategory.
- suites := suites
- collect:[:eachSuiteName |
- (testsWhichFailed includes:eachSuiteName) ifTrue:[
- eachSuiteName colorizeAllWith:(self class colorForFailedTests).
- ] ifFalse:[
- (testsWhichPassed includes:eachSuiteName) ifTrue:[
- eachSuiteName colorizeAllWith:(self class colorForPassedTests).
- ] ifFalse:[
- eachSuiteName
- ]
- ].
- ].
- self scriptModel value: suites.
+ suites := self suitesInCategory.
+ suites := suites
+ collect:[:eachSuiteName |
+ (testsWhichFailed includes:eachSuiteName) ifTrue:[
+ eachSuiteName colorizeAllWith:(self class colorForFailedTests).
+ ] ifFalse:[
+ (testsWhichPassed includes:eachSuiteName) ifTrue:[
+ eachSuiteName colorizeAllWith:(self class colorForPassedTests).
+ ] ifFalse:[
+ eachSuiteName
+ ]
+ ].
+ ].
+ self scriptModel value: suites.
! !
!TestRunner methodsFor:'private'!
@@ -726,45 +711,45 @@
!
allTestSuite
- "generate and return a suite for all tests, except SUnitTests"
+ "generate and return a suite for all tests, except SUnitTests"
- | tokens stream suite|
+ | tokens stream suite|
- tokens := (self suitesInCategory
- collect: [:eachName | eachName ", '*' " ])
- copyWithout: 'SUnitTest* '.
- stream := WriteStream on: String new.
- tokens do: [:each | stream nextPutAll:each; space].
- suite := TestSuitesScripter run: stream contents.
- suite name:'all'.
- ^ suite
+ tokens := (self suitesInCategory
+ collect: [:eachName | eachName ", '*' " ])
+ copyWithout: 'SUnitTest* '.
+ stream := WriteStream on: String new.
+ tokens do: [:each | stream nextPutAll:each; space].
+ suite := TestSuitesScripter run: stream contents.
+ suite name:'all'.
+ ^ suite
!
defectTestSuite
- |suite|
+ |suite|
- suite := TestSuite new.
- suite name:'defects'.
- allDefects keysAndValuesDo:[:nm :test |
- suite addTest:test.
- ].
- ^suite
+ suite := TestSuite new.
+ suite name:'defects'.
+ allDefects keysAndValuesDo:[:nm :test |
+ suite addTest:test.
+ ].
+ ^suite
!
-formatTime: aTime
+formatTime: aTime
aTime hours > 0 ifTrue: [^aTime hours printString , 'h'].
aTime minutes > 0 ifTrue: [^aTime minutes printString , 'min'].
^aTime seconds printString , ' sec'
!
freshTestSuite
- |tests suite|
+ |tests suite|
- tests := self tests contents.
- tests isNil ifTrue:[ ^ nil].
- tests := tests string.
- suite := TestSuitesScripter run: tests.
- ^ suite
+ tests := self tests contents.
+ tests isNil ifTrue:[ ^ nil].
+ tests := tests string.
+ suite := TestSuitesScripter run: tests.
+ ^ suite
"Modified: / 4.4.2000 / 20:13:41 / Sames"
!
@@ -776,23 +761,23 @@
testsWhichFailed := Set new.
TestCase allSubclassesDo:[:cls |
- |lastResult className|
+ |lastResult className|
- cls isAbstract ifFalse:[
- lastResult := cls lastTestRunResultOrNil.
- lastResult notNil ifTrue:[
- className := cls name.
- lastResult == true ifTrue:[
- testsWhichPassed add:className
- ] ifFalse:[
- testsWhichFailed add:className
- ]
- ]
- ]
+ cls isAbstract ifFalse:[
+ lastResult := cls lastTestRunResultOrNil.
+ lastResult notNil ifTrue:[
+ className := cls name.
+ lastResult == true ifTrue:[
+ testsWhichPassed add:className
+ ] ifFalse:[
+ testsWhichFailed add:className
+ ]
+ ]
+ ]
].
!
-postOpenWith: aBuilder
+postOpenWith: aBuilder
"automatically generated by UIPainter ..."
super postOpenWith: aBuilder.
@@ -833,7 +818,7 @@
scriptClass := Smalltalk at:aScriptName asSymbol.
scriptClass notNil ifTrue:[
- self category value:scriptClass category.
+ self category value:scriptClass category.
]
!
@@ -842,7 +827,7 @@
scriptIndex := self script value.
scriptIndex isNil ifTrue:[
- ^ ''
+ ^ ''
].
^ self scriptModel value at:scriptIndex ifAbsent:nil.
!
@@ -854,7 +839,7 @@
self addToFailedTests:caseName.
(cls := Smalltalk classNamed:caseName) notNil ifTrue:[
- cls rememberFailedTestRunWithResult:result.
+ cls rememberFailedTestRunWithResult:result.
].
!
@@ -868,7 +853,7 @@
"/ Transcript show:'passed: '; showCR:caseName className.
(cls := Smalltalk classNamed:caseName) notNil ifTrue:[
- cls rememberPassedTestRun
+ cls rememberPassedTestRun
].
!
@@ -896,13 +881,13 @@
"Modified: / 21.6.2000 / 12:35:09 / Sames"
!
-displayDefects: aCollection
+displayDefects: aCollection
| failedTests|
aCollection isEmpty ifTrue: [
- self selectionHolder value:''.
- self enableDefects value:false.
- self enableDebugButton value:false.
- ^ self
+ self selectionHolder value:''.
+ self enableDefects value:false.
+ self enableDebugButton value:false.
+ ^ self
].
allDefects := Dictionary new.
aCollection do: [:each | allDefects at: each printString put: each].
@@ -914,7 +899,7 @@
"Modified: / 4.4.2000 / 20:11:06 / Sames"
!
-displayDetails: aString
+displayDetails: aString
self details value: aString.
self repairDamage.
@@ -943,9 +928,9 @@
self displayColor: ColorValue green
!
-displayMode: aString
- self mode value: aString.
- self repairDamage.
+displayMode: aString
+ self mode value: aString.
+ self repairDamage.
"Modified: / 21.6.2000 / 11:14:19 / Sames"
!
@@ -958,11 +943,11 @@
displayPass
self displayGreen.
- (lastTestCase notNil
+ (lastTestCase notNil
and:[lastTestCase name notNil]) ifTrue:[
- self displayMode: 'Pass ' , lastTestCase name.
+ self displayMode: 'Pass ' , lastTestCase name.
] ifFalse:[
- self displayMode: 'Pass'.
+ self displayMode: 'Pass'.
].
self displayDetails: result runCount printString , ' run' , self timeSinceLastPassAsString.
lastPass := Time now
@@ -988,14 +973,14 @@
!
displayRunning
- self displayRunning:(self selectedScript ? 'all') string.
+ self displayRunning:(self selectedScript ? 'all') string.
!
displayRunning:scriptName
- self displayYellow.
- self displayMode:('running ' , scriptName allBold).
+ self displayYellow.
+ self displayMode:('running ' , scriptName allBold).
"/ self displayDetails: '...'.
- self repairDamage.
+ self repairDamage.
!
displayYellow
@@ -1018,60 +1003,64 @@
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
- (changedObject isBehavior and:[changedObject isSubclassOf:TestCase]) ifTrue:[
- self updateSuitesList
- ].
- ^ self
+ (changedObject isBehavior and:[changedObject isSubclassOf:TestCase]) ifTrue:[
+ self updateSuitesList
+ ].
+ ^ self
].
(changedObject isKindOf: TestSuite) ifTrue: [
- self displayRunning:changedObject name.
- ^ self
+ self displayRunning:changedObject name.
+ ^ self
].
(changedObject isKindOf: TestCase) ifTrue: [
- (result errorCount + result failureCount) > 0 ifTrue:[
- self displayErrorColorInProgress.
- ].
- self percentageDone value:(result runCount / numberOfTestsToRun * 100) rounded.
- self displayDetails: changedObject printString.
- ^ self
+ (result errorCount + result failureCount) > 0 ifTrue:[
+ self displayErrorColorInProgress.
+ ].
+ self percentageDone value:(result runCount / numberOfTestsToRun * 100) rounded.
+ self displayDetails: changedObject printString.
+ ^ self
].
super update:something with:aParameter from:changedObject
!
updateDefects
- |script|
+ |script|
- script := self selectedScript.
- script notNil ifTrue:[script := script string].
+ script := self selectedScript.
+ script notNil ifTrue:[script := script string].
- self displayDefects: result defects.
+ self displayDefects: result defects.
- script notNil ifTrue:[
- result hasPassed ifTrue:[
- self testPassed:script
- ] ifFalse:[
- self testFailed:script withResult:result
- ].
- ].
+ script notNil ifTrue:[
+ result hasPassed ifTrue:[
+ self testPassed:script
+ ] ifFalse:[
+ self testFailed:script withResult:result
+ ].
+ ].
!
updateWindow
- result hasPassed
- ifTrue: [self displayPass]
- ifFalse: [self displayFail].
- self updateDefects.
- self updateSuitesList. "/ for colors
+ result hasPassed
+ ifTrue: [self displayPass]
+ ifFalse: [self displayFail].
+ self updateDefects.
+ self updateSuitesList. "/ for colors
! !
!TestRunner class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.59 2009-10-04 13:24:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.60 2011-06-29 19:15:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.59 2009-10-04 13:24:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.60 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestRunner.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/TestSuite.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuite.st Wed Jun 29 21:15:49 2011 +0200
@@ -7,51 +7,54 @@
category:'SUnit-Base'
!
-TestSuite comment:'This is a Composite of Tests, either TestCases or other TestSuites. The common protocol is #run: aTestResult and the dependencies protocol'
+TestSuite comment:''
!
-!TestSuite class methodsFor:'Creation'!
+!TestSuite class methodsFor:'instance creation'!
named: aString
^self new
name: aString;
yourself
-
! !
!TestSuite methodsFor:'accessing'!
addTest: aTest
self tests add: aTest
-
!
-addTests: aCollection
+addTests: aCollection
aCollection do: [:eachTest | self addTest: eachTest]
-
!
defaultResources
- ^self tests
- inject: Set new
- into: [:coll :testCase |
- coll
- addAll: testCase resources;
- yourself]
-
+ ^self tests
+ inject: OrderedCollection new
+ into:
+ [:coll :testCase |
+ testCase resources do:
+ [:each |
+ (coll includes: each) ifFalse: [coll add: each]].
+ coll]
+!
+
+getTestName
+ ^self name
+
+ "Created: / 12-09-2006 / 11:38:09 / cg"
!
name
- ^ name ? 'a TestSuite'.
+ ^name
!
name: aString
name := aString
-
!
nameOfTest
@@ -61,36 +64,29 @@
resources
resources isNil ifTrue: [resources := self defaultResources].
^resources
-
!
-resources: anObject
- resources := anObject
-
-!
+resources: someOrderedTestResourceClasses
+ "The parameter should understand reverseDo: and should not contain duplicates."
-testName
- ^ self name
-
- "Created: / 12-09-2006 / 11:38:09 / cg"
+ resources := someOrderedTestResourceClasses
!
tests
tests isNil ifTrue: [tests := OrderedCollection new].
^tests
-
! !
!TestSuite methodsFor:'dependencies'!
addDependentToHierachy: anObject
- self addDependent: anObject.
- self tests do: [ :each | each addDependentToHierachy: anObject]
+ self sunitAddDependent: anObject.
+ self tests do: [ :each | each addDependentToHierachy: anObject]
!
removeDependentFromHierachy: anObject
- self removeDependent: anObject.
- self tests do: [ :each | each removeDependentFromHierachy: anObject]
+ self sunitRemoveDependent: anObject.
+ self tests do: [ :each | each removeDependentFromHierachy: anObject]
! !
!TestSuite methodsFor:'queries'!
@@ -106,80 +102,117 @@
!TestSuite methodsFor:'running'!
run
- | result |
-
- self signalUnavailableResources.
+ | result |
+ result := TestResult new.
+ [self run: result]
+ "sunitEnsure: [self resources reverseDo: [:each | each reset]]."
+ sunitEnsure: [TestResource resetResources: self resources].
+ ^result
- result := TestResult new.
- [self run: result] ensure: [self resources do: [:each | each reset]].
- ^result
+ "Modified: / 11-09-2010 / 16:47:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-run: aResult
- self tests do: [:each |
- self changed: each.
- each run: aResult]
+run:aResult
+
+ aResult name:name.
+ self tests do:[:each |
+ self sunitChanged:each.
+ each run:aResult
+ ]
+
+ "Modified: / 19-03-2010 / 08:03:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
run: aResult afterEachDo:block2
- self tests do:
- [:each |
- self changed: each.
- each run: aResult afterEachDo:block2.
-"/ block2 value:each value:aResult
- ]
- "Modified: / 21.6.2000 / 10:14:01 / Sames"
+ aResult name: name.
+ self tests do:
+ [:each |
+ self changed: each.
+ each run: aResult afterEachDo:block2]
+
+ "Modified: / 21-06-2000 / 10:14:01 / Sames"
+ "Modified: / 19-03-2010 / 08:01:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-run: aResult beforeEachDo:block1 afterEachDo:block2
-
- |class|
-
- class := Smalltalk classNamed:name.
- class perform:#setUp ifNotUnderstood:nil.
+run:aResult beforeEachDo:block1 afterEachDo:block2
+ |class|
- [
- self tests do:
- [:each |
- self changed: each.
- block1 value:each value:aResult.
- each run: aResult beforeEachDo:block1 afterEachDo:block2.
- "/ each run: aResult.
- block2 value:each value:aResult.
- ].
- ] ensure: [self resources do:[:e|e reset]].
+ aResult name: name.
+ class := name ifNotNil:[ Smalltalk classNamed:name ] ifNil:[ nil ].
+ class ifNotNil:[ class perform:#setUp ifNotUnderstood:nil ].
+ [
+ self tests do:[:each |
+ self sunitChanged:each.
+ block1 value:each value:aResult.
+ each
+ run:aResult
+ beforeEachDo:block1
+ afterEachDo:block2.
- class perform:#tearDown ifNotUnderstood:nil
+ "/ each run: aResult.
+
+ block2 value:each value:aResult.
+ ].
+ ] ensure:[
+ self resources do:[:e |
+ e reset
+ ]
+ ].
+ class ifNotNil:[ class perform:#tearDown ifNotUnderstood:nil ]
+
+ "Modified: / 19-03-2010 / 08:02:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
- self tests do:
- [:each |
- self changed: each.
- each run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2.
- ]
+run:aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
+
+ aResult name: name.
+ self tests do:[:each |
+ self changed:each.
+ each
+ run:aResult
+ beforeEachTestCaseDo:block1
+ afterEachTestCaseDo:block2.
+ ]
+
+ "Modified: / 19-03-2010 / 08:02:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runAfterEachDo: aBlock
+ | result |
+ result := TestResult new.
+ result name: name.
+ [self run: result afterEachDo: aBlock]
+ sunitEnsure: [self resources reverseDo: [:each | each reset]].
+ ^result
+
+ "Created: / 15-03-2010 / 20:36:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-03-2010 / 08:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestSuite methodsFor:'testing'!
areAllResourcesAvailable
- ^self resources
+ ^self resources
inject: true
into: [:total :each | each isAvailable & total]
!
signalUnavailableResources
- self resources do:[:res |
- res isAvailable ifFalse:[
- ^ res signalInitializationError
- ]
+ self resources do:[:res |
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
].
! !
!TestSuite class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.18 2009-09-21 08:10:10 fm Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.19 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestSuite.st 203 2010-09-11 14:49:03Z vranyj1 §'
! !
--- a/TestSuitesCompoundScriptTest.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuitesCompoundScriptTest.st Wed Jun 29 21:15:49 2011 +0200
@@ -17,5 +17,9 @@
!TestSuitesCompoundScriptTest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesCompoundScriptTest.st,v 1.4 2002-02-26 10:30:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesCompoundScriptTest.st,v 1.5 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestSuitesCompoundScriptTest.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/TestSuitesHierarchyScriptTest.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuitesHierarchyScriptTest.st Wed Jun 29 21:15:49 2011 +0200
@@ -19,5 +19,9 @@
!TestSuitesHierarchyScriptTest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesHierarchyScriptTest.st,v 1.4 2002-02-26 10:30:43 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesHierarchyScriptTest.st,v 1.5 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestSuitesHierarchyScriptTest.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/TestSuitesScriptTest.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuitesScriptTest.st Wed Jun 29 21:15:49 2011 +0200
@@ -17,13 +17,13 @@
!TestSuitesScriptTest methodsFor:'testing'!
testCompoundScript
- | allTestCaseClasses superCase subCase |
- allTestCaseClasses := (scripter run: 'TestSuitesHierarchyScriptTest TestSuitesCompoundScriptTest') tests.
- self assert: allTestCaseClasses size = 2.
- superCase := (allTestCaseClasses at: 1) tests first.
- self assert: superCase class name asSymbol == #TestSuitesHierarchyScriptTest.
- subCase := (allTestCaseClasses at: 2) tests first.
- self assert: subCase class name asSymbol == #TestSuitesCompoundScriptTest.
+ | allTestCaseClasses superCase subCase |
+ allTestCaseClasses := (scripter run: 'TestSuitesHierarchyScriptTest TestSuitesCompoundScriptTest') tests.
+ self assert: allTestCaseClasses size = 2.
+ superCase := (allTestCaseClasses at: 1) tests first.
+ self assert: superCase class name asSymbol == #TestSuitesHierarchyScriptTest.
+ subCase := (allTestCaseClasses at: 2) tests first.
+ self assert: subCase class name asSymbol == #TestSuitesCompoundScriptTest.
"Modified: / 21.6.2000 / 10:26:48 / Sames"
!
@@ -57,14 +57,14 @@
!
testHierachyScript
- | allTestCaseClasses superCase subCase |
- suite := scripter run: 'TestSuitesHierarchyScriptTest*'.
- allTestCaseClasses := suite tests.
- self assert: allTestCaseClasses size = 1.
- superCase := (allTestCaseClasses first tests at: 1) tests first.
- self assert: superCase class name asSymbol = #TestSuitesHierarchyScriptTest.
- subCase := (allTestCaseClasses first tests at: 2) tests first.
- self assert: subCase class name asSymbol = #TestSuitesCompoundScriptTest.
+ | allTestCaseClasses superCase subCase |
+ suite := scripter run: 'TestSuitesHierarchyScriptTest*'.
+ allTestCaseClasses := suite tests.
+ self assert: allTestCaseClasses size = 1.
+ superCase := (allTestCaseClasses first tests at: 1) tests first.
+ self assert: superCase class name asSymbol = #TestSuitesHierarchyScriptTest.
+ subCase := (allTestCaseClasses first tests at: 2) tests first.
+ self assert: subCase class name asSymbol = #TestSuitesCompoundScriptTest.
"Modified: / 21.6.2000 / 10:28:02 / Sames"
!
@@ -77,12 +77,12 @@
!
testSimpleScript
- | allTestCaseClasses case |
- suite := scripter run: 'TestSuitesHierarchyScriptTest'.
- allTestCaseClasses := suite tests.
- self assert: allTestCaseClasses size = 1.
- case := (allTestCaseClasses at: 1) tests at: 1.
- self assert: case class name asSymbol = #TestSuitesHierarchyScriptTest.
+ | allTestCaseClasses case |
+ suite := scripter run: 'TestSuitesHierarchyScriptTest'.
+ allTestCaseClasses := suite tests.
+ self assert: allTestCaseClasses size = 1.
+ case := (allTestCaseClasses at: 1) tests at: 1.
+ self assert: case class name asSymbol = #TestSuitesHierarchyScriptTest.
"Modified: / 21.6.2000 / 10:28:35 / Sames"
!
@@ -104,5 +104,9 @@
!TestSuitesScriptTest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScriptTest.st,v 1.5 2003-09-26 16:00:27 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScriptTest.st,v 1.6 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: TestSuitesScriptTest.st 182 2009-12-05 18:12:17Z vranyj1 §'
! !
--- a/TestSuitesScripter.st Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuitesScripter.st Wed Jun 29 21:15:49 2011 +0200
@@ -119,5 +119,9 @@
!TestSuitesScripter class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScripter.st,v 1.9 2008-09-03 08:50:28 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScripter.st,v 1.10 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+ ^ '$Id: TestSuitesScripter.st,v 1.10 2011-06-29 19:15:49 cg Exp $'
! !
--- a/abbrev.stc Wed Jun 29 20:38:32 2011 +0200
+++ b/abbrev.stc Wed Jun 29 21:15:49 2011 +0200
@@ -1,19 +1,33 @@
-ExampleSetTest ExampleSetTest stx:goodies/sunit 'SUnit-Tests' 2
ExampleTestResource ExampleTestResource stx:goodies/sunit 'SUnit-Tests' 1
-ResumableTestFailureTestCase ResumableTestFailureTestCase stx:goodies/sunit 'SUnit-Tests' 2
SUnitDelay SUnitDelay stx:goodies/sunit 'SUnit-Preload' 0
SUnitNameResolver SUnitNameResolver stx:goodies/sunit 'SUnit-Preload' 0
-SUnitTest SUnitTest stx:goodies/sunit 'SUnit-Tests' 2
-SimpleTestResourceTestCase SimpleTestResourceTestCase stx:goodies/sunit 'SUnit-Tests' 2
-TestCase TestCase stx:goodies/sunit 'SUnit-Base' 2
+TestAsserter TestAsserter stx:goodies/sunit 'SUnit-Base' 0
+TestCaseWithArguments TestCaseWithArguments stx:goodies/sunit 'SUnit-Base' 4
TestFailure TestFailure stx:goodies/sunit 'SUnit-Preload' 1
-TestResource TestResource stx:goodies/sunit 'SUnit-Base' 1
TestResult TestResult stx:goodies/sunit 'SUnit-Base' 0
+TestResultReporter TestResultReporter stx:goodies/sunit 'SUnit-Report' 0
TestRunner TestRunner stx:goodies/sunit 'SUnit-UI' 1
TestSuite TestSuite stx:goodies/sunit 'SUnit-Base' 0
-TestSuitesHierarchyScriptTest TestSuitesHierarchyScriptTest stx:goodies/sunit 'SUnit-Tests' 2
-TestSuitesScriptTest TestSuitesScriptTest stx:goodies/sunit 'SUnit-Tests' 2
+TestSuitesCompoundScriptTest TestSuitesCompoundScriptTest stx:goodies/sunit 'SUnit-Tests' 4
+TestSuitesHierarchyScriptTest TestSuitesHierarchyScriptTest stx:goodies/sunit 'SUnit-Tests' 4
+TestSuitesScriptTest TestSuitesScriptTest stx:goodies/sunit 'SUnit-Tests' 4
TestSuitesScripter TestSuitesScripter stx:goodies/sunit 'SUnit-Base' 0
-stx_goodies_sunit stx_goodies_sunit stx:goodies/sunit '* Projects & Packages *' 2
+stx_goodies_sunit stx_goodies_sunit stx:goodies/sunit '* Projects & Packages *' 4
ResumableTestFailure ResumableTestFailure stx:goodies/sunit 'SUnit-Preload' 1
-TestCaseWithArguments TestCaseWithArguments stx:goodies/sunit 'SUnit-Base' 2
+TestCase TestCase stx:goodies/sunit 'SUnit-Base' 4
+TestResource TestResource stx:goodies/sunit 'SUnit-Base' 1
+ExampleSetTest ExampleSetTest stx:goodies/sunit 'SUnit-Tests' 4
+ResumableTestFailureTestCase ResumableTestFailureTestCase stx:goodies/sunit 'SUnit-Tests' 4
+SUnitTest SUnitTest stx:goodies/sunit 'SUnit-Tests' 4
+SimpleTestResource SimpleTestResource stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceTestCase SimpleTestResourceTestCase stx:goodies/sunit 'SUnit-Tests' 4
+FailingTestResourceTestCase FailingTestResourceTestCase stx:goodies/sunit 'SUnit-Tests' 4
+ManyTestResourceTestCase ManyTestResourceTestCase stx:goodies/sunit 'SUnit-Tests' 4
+SimpleTestResourceA SimpleTestResourceA stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceA1 SimpleTestResourceA1 stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceA2 SimpleTestResourceA2 stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceB SimpleTestResourceB stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceB1 SimpleTestResourceB1 stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceCircular SimpleTestResourceCircular stx:goodies/sunit 'SUnit-Tests' 2
+SimpleTestResourceCircular1 SimpleTestResourceCircular1 stx:goodies/sunit 'SUnit-Tests' 2
+CircularTestResourceTestCase CircularTestResourceTestCase stx:goodies/sunit 'SUnit-Tests' 4
--- a/bc.mak Wed Jun 29 20:38:32 2011 +0200
+++ b/bc.mak Wed Jun 29 21:15:49 2011 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/goodies/sunit/bc.mak,v 1.7 2009-10-06 07:56:29 cg Exp $
+# $Header: /cvs/stx/stx/goodies/sunit/bc.mak,v 1.8 2011-06-29 19:15:49 cg Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_goodies_sunit.
@@ -17,6 +17,8 @@
TOP=..\..
INCLUDE_TOP=$(TOP)\..
+
+
!INCLUDE $(TOP)\rules\stdHeader_bc
!INCLUDE Make.spec
@@ -26,7 +28,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libview2 -I$(INCLUDE_TOP)\stx\libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libview -I$(INCLUDE_TOP)\stx\libview2 -I$(INCLUDE_TOP)\stx\libbasic
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -H. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -34,35 +36,19 @@
OBJS= $(COMMON_OBJS) $(WIN32_OBJS)
-ALL:: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
+ALL:: classLibRule
+
+classLibRule: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
!INCLUDE $(TOP)\rules\stdRules_bc
# build all prerequisite packages for this package
prereq:
- cd ..\..\libbasic
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libbasic2
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libcomp
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libview
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libbasic3
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libview2
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libui
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libwidg
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libwidg2
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\libtool
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\librun
- bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- cd ..\goodies\sunit
+ pushd ..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\librun & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
@@ -70,15 +56,16 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
$(OUTDIR)SUnitDelay.$(O) SUnitDelay.$(H): SUnitDelay.st $(INCLUDE_TOP)\stx\libbasic\Delay.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)SUnitNameResolver.$(O) SUnitNameResolver.$(H): SUnitNameResolver.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)TestCase.$(O) TestCase.$(H): TestCase.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)TestAsserter.$(O) TestAsserter.$(H): TestAsserter.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)TestFailure.$(O) TestFailure.$(H): TestFailure.st $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)TestResource.$(O) TestResource.$(H): TestResource.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)TestResult.$(O) TestResult.$(H): TestResult.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)TestRunner.$(O) TestRunner.$(H): TestRunner.st $(INCLUDE_TOP)\stx\libview2\ApplicationModel.$(H) $(INCLUDE_TOP)\stx\libview2\Model.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)TestSuite.$(O) TestSuite.$(H): TestSuite.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)TestSuitesScripter.$(O) TestSuitesScripter.$(H): TestSuitesScripter.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)stx_goodies_sunit.$(O) stx_goodies_sunit.$(H): stx_goodies_sunit.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)ResumableTestFailure.$(O) ResumableTestFailure.$(H): ResumableTestFailure.st $(INCLUDE_TOP)\stx\goodies\sunit\TestFailure.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)TestCaseWithArguments.$(O) TestCaseWithArguments.$(H): TestCaseWithArguments.st $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)TestCase.$(O) TestCase.$(H): TestCase.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)TestResource.$(O) TestResource.$(H): TestResource.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Block.$(H) $(INCLUDE_TOP)\stx\libbasic\CompiledCode.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Class.$(H) $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\String.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\ByteArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Symbol.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/bmake.bat Wed Jun 29 20:38:32 2011 +0200
+++ b/bmake.bat Wed Jun 29 21:15:49 2011 +0200
@@ -1,4 +1,8 @@
-
+@REM -------
+@REM make using borland bcc
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
make.exe -N -f bc.mak %1 %2
--- a/extensions.st Wed Jun 29 20:38:32 2011 +0200
+++ b/extensions.st Wed Jun 29 21:15:49 2011 +0200
@@ -1,21 +1,122 @@
-"{ Package: 'stx:goodies/sunit' }"!
+"{ Package: 'stx:goodies/sunit' }"
-!Behavior methodsFor:'Camp Smalltalk'!
+!
+
+!Behavior methodsFor:'deprecated'!
sunitAllSelectors
- ^self allSelectors asSortedCollection asOrderedCollection
+
+ <resource: #obsolete>
+ self obsoleteMethodWarning: 'Use #testSelectors instead'.
+ ^self allSelectors
+
+ "Modified: / 11-09-2010 / 15:07:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!Behavior methodsFor:'Camp Smalltalk'!
sunitSelectors
- ^self selectors asSortedCollection asOrderedCollection
+
+ ^self selectors
+
+ "Modified: / 11-09-2010 / 15:07:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+!Block methodsFor:'Camp Smalltalk'!
+
+sunitEnsure: aBlock
+
+ ^self ensure: aBlock
+! !
+!Block methodsFor:'Camp Smalltalk'!
+
+sunitOn: aSignal do: anExceptionBlock
+
+ ^self on: aSignal do: anExceptionBlock
+! !
+!Class methodsFor:'Camp Smalltalk'!
- "Created: / 20.6.2000 / 11:54:54 / Sames"
+sunitName
+
+ ^self name
+! !
+!Exception methodsFor:'Camp Smalltalk'!
+
+sunitAnnounce: aTestCase toResult: aTestResult
+ aTestResult addError: aTestCase.
+ self sunitExitWith: false.
! !
+!Exception methodsFor:'Camp Smalltalk'!
+
+sunitExitWith: aValue
+
+ ^self return: aValue
+! !
+!Object methodsFor:'Camp Smalltalk'!
+
+sunitAddDependent: anObject
+
+ self addDependent: anObject
+! !
+!Object methodsFor:'Camp Smalltalk'!
+
+sunitChanged: aspect
+
+ self changed: aspect
+! !
+!Object methodsFor:'Camp Smalltalk'!
-!stx_goodies_sunit class methodsFor:'documentation'!
+sunitRemoveDependent: anObject
+
+ self removeDependent: anObject
+! !
+!String methodsFor:'Camp Smalltalk'!
+
+sunitAsSymbol
+
+ ^self asSymbol
+! !
+!String methodsFor:'Camp Smalltalk'!
+
+sunitMatch: aString
+
+ ^self match: aString
+! !
+!String methodsFor:'deprecated'!
+
+sunitSubStrings
-extensionsVersion_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/extensions.st,v 1.8 2011-06-28 12:39:06 cg Exp $'
-! !
\ No newline at end of file
+ <resource: #obsolete>
+
+ | stream answer index |
+ answer := OrderedCollection new.
+ stream := ReadStream on: self.
+ [stream atEnd]
+ whileFalse:
+ [[stream atEnd ifTrue: [^answer asArray].
+ stream peek > Character space] whileFalse: [stream next].
+ index := stream position + 1.
+ [stream atEnd or: [stream peek <= Character space]] whileFalse: [stream next].
+ answer
+ add:
+ (self
+ copyFrom: index
+ to: stream position)].
+ ^answer asArray
+
+ "Modified: / 11-09-2010 / 15:14:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+!Symbol methodsFor:'Camp Smalltalk'!
+
+sunitAsClass
+
+ ^SUnitNameResolver classNamed: self
+! !
+!GenericException class methodsFor:'Camp Smalltalk'!
+
+sunitSignalWith: aString
+
+ <resource: #skipInDebuggersWalkBack>
+
+ ^self raiseSignal: aString
+
+ "Modified: / 05-12-2009 / 18:29:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lcmake.bat Wed Jun 29 21:15:49 2011 +0200
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using lcc compiler
+@REM type lcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak USELCC=1 %1 %2
+
+
--- a/libInit.cc Wed Jun 29 20:38:32 2011 +0200
+++ b/libInit.cc Wed Jun 29 21:15:49 2011 +0200
@@ -1,7 +1,7 @@
/*
- * $Header: /cvs/stx/stx/goodies/sunit/libInit.cc,v 1.6 2008-10-31 12:49:15 cg Exp $
+ * $Header: /cvs/stx/stx/goodies/sunit/libInit.cc,v 1.7 2011-06-29 19:15:49 cg Exp $
*
- * DO NOT EDIT
+ * DO NOT EDIT
* automagically generated from the projectDefinition: stx_goodies_sunit.
*/
#define __INDIRECTVMINITCALLS__
@@ -9,28 +9,37 @@
#ifdef WIN32
# pragma codeseg INITCODE "INITCODE"
-#endif
+#endif
#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
DLL_EXPORT void _libstx_goodies_sunit_Init() INIT_TEXT_SECTION;
+// DLL_EXPORT void _libstx_goodies_sunit_InitDefinition() INIT_TEXT_SECTION;
#endif
+// void _libstx_goodies_sunit_InitDefinition(pass, __pRT__, snd)
+// OBJ snd; struct __vmData__ *__pRT__; {
+// __BEGIN_PACKAGE2__("libstx_goodies_sunit__DFN", _libstx_goodies_sunit_InitDefinition, "stx:goodies/sunit");
+// _stx_137goodies_137sunit_Init(pass,__pRT__,snd);
+
+// __END_PACKAGE__();
+// }
+
void _libstx_goodies_sunit_Init(pass, __pRT__, snd)
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_sunit", _libstx_goodies_sunit_Init, "stx:goodies/sunit");
_SUnitDelay_Init(pass,__pRT__,snd);
_SUnitNameResolver_Init(pass,__pRT__,snd);
-_TestCase_Init(pass,__pRT__,snd);
+_TestAsserter_Init(pass,__pRT__,snd);
_TestFailure_Init(pass,__pRT__,snd);
-_TestResource_Init(pass,__pRT__,snd);
_TestResult_Init(pass,__pRT__,snd);
_TestRunner_Init(pass,__pRT__,snd);
_TestSuite_Init(pass,__pRT__,snd);
_TestSuitesScripter_Init(pass,__pRT__,snd);
_stx_137goodies_137sunit_Init(pass,__pRT__,snd);
_ResumableTestFailure_Init(pass,__pRT__,snd);
-_TestCaseWithArguments_Init(pass,__pRT__,snd);
+_TestCase_Init(pass,__pRT__,snd);
+_TestResource_Init(pass,__pRT__,snd);
-
+_stx_137goodies_137sunit_extensions_Init(pass,__pRT__,snd);
__END_PACKAGE__();
}
--- a/stx_goodies_sunit.st Wed Jun 29 20:38:32 2011 +0200
+++ b/stx_goodies_sunit.st Wed Jun 29 21:15:49 2011 +0200
@@ -10,12 +10,26 @@
!stx_goodies_sunit class methodsFor:'description'!
-preRequisites
+excludedFromPreRequisites
+ "list all packages which should be ignored in the automatic
+ preRequisites scan. See #preRequisites for more."
+
^ #(
- #'stx:libbasic' "OrderedCollection - referenced by TestResult>>tests "
- #'stx:libtool' "XPToolbarIconLibrary - referenced by TestRunner class>>defaultIcon "
- #'stx:libview' "Color - referenced by TestRunner>>displayNormalColorInProgress "
- #'stx:libview2' "ColorValue - referenced by TestRunner>>displayYellow "
+ )
+!
+
+preRequisites
+ "list all required packages.
+ This list can be maintained manually or (better) generated and
+ updated by scanning the superclass hierarchies and looking for
+ global variable accesses. (the browser has a menu function for that)
+ Howevery, often too much is found, and you may want to explicitely
+ exclude individual packages in the #excludedFromPrerequisites method."
+
+ ^ #(
+ #'stx:libbasic' "Object - superclass of SimpleTestResourceB1 "
+ #'stx:libview' "Color - referenced by TestRunner>>displayNormalColorInProgress "
+ #'stx:libview2' "Model - superclass of TestRunner "
)
! !
@@ -28,32 +42,63 @@
Attributes are: #autoload or #<os> where os is one of win32, unix,..."
^ #(
- "<className> or (<className> attributes...) in load order"
- (ExampleSetTest autoload)
- (ExampleTestResource autoload)
- (ResumableTestFailureTestCase autoload)
- SUnitDelay
- SUnitNameResolver
- (SUnitTest autoload)
- (SimpleTestResourceTestCase autoload)
- TestCase
- TestFailure
- TestResource
- TestResult
- TestRunner
- TestSuite
- (TestSuitesHierarchyScriptTest autoload)
- (TestSuitesScriptTest autoload)
- TestSuitesScripter
- #'stx_goodies_sunit'
- ResumableTestFailure
- TestCaseWithArguments
- (TestTester autoload)
+ "<className> or (<className> attributes...) in load order"
+ (ExampleTestResource autoload)
+ SUnitDelay
+ SUnitNameResolver
+ TestAsserter
+ (TestCaseWithArguments autoload)
+ TestFailure
+ TestResult
+ (TestResultReporter autoload)
+ TestRunner
+ TestSuite
+ (TestSuitesCompoundScriptTest autoload)
+ (TestSuitesHierarchyScriptTest autoload)
+ (TestSuitesScriptTest autoload)
+ TestSuitesScripter
+ #'stx_goodies_sunit'
+ ResumableTestFailure
+ TestCase
+ TestResource
+ (ExampleSetTest autoload)
+ (ResumableTestFailureTestCase autoload)
+ (SUnitTest autoload)
+ (SimpleTestResource autoload)
+ (SimpleTestResourceTestCase autoload)
+ (FailingTestResourceTestCase autoload)
+ (ManyTestResourceTestCase autoload)
+ (SimpleTestResourceA autoload)
+ (SimpleTestResourceA1 autoload)
+ (SimpleTestResourceA2 autoload)
+ (SimpleTestResourceB autoload)
+ (SimpleTestResourceB1 autoload)
+ (SimpleTestResourceCircular autoload)
+ (SimpleTestResourceCircular1 autoload)
+ (CircularTestResourceTestCase autoload)
)
!
extensionMethodNames
+ "lists the extension methods which are to be included in the project.
+ Entries are 2-element array literals, consisting of class-name and selector."
+
^ #(
+ Behavior sunitAllSelectors
+ Behavior sunitSelectors
+ Block sunitEnsure:
+ Block sunitOn:do:
+ Class sunitName
+ Exception sunitAnnounce:toResult:
+ Exception sunitExitWith:
+ Object sunitAddDependent:
+ Object sunitChanged:
+ Object sunitRemoveDependent:
+ String sunitAsSymbol
+ String sunitMatch:
+ String sunitSubStrings
+ Symbol sunitAsClass
+ 'GenericException class' sunitSignalWith:
)
! !
@@ -68,25 +113,32 @@
description
"Return a description string which will appear in nt.def / bc.def"
- ^ 'Smalltalk/X Unit Testing library'
-
- "Modified: / 23-11-2010 / 17:40:18 / cg"
+ ^ 'Smalltalk/X Class library'
!
legalCopyright
"Return a copyright string which will appear in <lib>.rc"
- ^ 'Copyright eXept Software AG 2002-2011'
+ ^ 'Copyright eXept Software AG 1998-2007'
+
+ "Modified: / 08-11-2007 / 16:57:33 / cg"
+! !
- "Modified: / 01-02-2011 / 11:54:48 / cg"
+!stx_goodies_sunit class methodsFor:'description - svn'!
+
+svnRevisionNr
+ "Return a SVN revision number of myself.
+ This number is updated after a commit"
+
+ ^ "$SVN-Revision:"'218M'"$"
! !
!stx_goodies_sunit class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/stx_goodies_sunit.st,v 1.12 2011-02-01 10:57:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/stx_goodies_sunit.st,v 1.13 2011-06-29 19:15:49 cg Exp $'
!
-version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/sunit/stx_goodies_sunit.st,v 1.12 2011-02-01 10:57:09 cg Exp $'
+version_SVN
+ ^ '§Id: stx_goodies_sunit.st 214 2011-03-14 12:22:21Z vranyj1 §'
! !
--- a/sunit.rc Wed Jun 29 20:38:32 2011 +0200
+++ b/sunit.rc Wed Jun 29 21:15:49 2011 +0200
@@ -3,8 +3,8 @@
// automagically generated from the projectDefinition: stx_goodies_sunit.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 5,4,1,8
- PRODUCTVERSION 5,4,3,1
+ FILEVERSION 6,1,212,212
+ PRODUCTVERSION 6,1,2,1
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
FILEOS VOS_NT_WINDOWS32
@@ -17,13 +17,13 @@
BLOCK "040904E4"
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
- VALUE "FileDescription", "Smalltalk/X Class library Lib\0"
- VALUE "FileVersion", "5.4.1.8\0"
+ VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
+ VALUE "FileVersion", "6.1.212.212\0"
VALUE "InternalName", "stx:goodies/sunit\0"
VALUE "LegalCopyright", "Copyright eXept Software AG 1998-2007\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "5.4.3.1\0"
- VALUE "ProductDate", "Fri, 31 Oct 2008 12:48:57 GMT\0"
+ VALUE "ProductVersion", "6.1.2.1\0"
+ VALUE "ProductDate", "Mon, 14 Mar 2011 12:21:37 GMT\0"
END
END
--- a/vcmake.bat Wed Jun 29 20:38:32 2011 +0200
+++ b/vcmake.bat Wed Jun 29 21:15:49 2011 +0200
@@ -1,2 +1,8 @@
+@REM -------
+@REM make using microsoft visual c
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak -DUSEVC %1 %2
-make.exe -N -f bc.mak USEVC=1 %1 %2
+