--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ExampleSetTest.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,50 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:03 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+TestCase subclass:#ExampleSetTest
+ instanceVariableNames:'full empty'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitTests'
+!
+
+!ExampleSetTest methodsFor:'Running'!
+
+setUp
+ empty := Set new.
+ full := Set with: 5 with: #abc! !
+
+!ExampleSetTest methodsFor:'Testing'!
+
+testAdd
+ empty add: 5.
+ self assert: (empty includes: 5)!
+
+testGrow
+ empty addAll: (1 to: 100).
+ self assert: empty size = 100!
+
+testIllegal
+ self
+ should: [empty at: 5]
+ raise: TestResult error.
+ self
+ should: [empty at: 5 put: #abc]
+ raise: TestResult error!
+
+testIncludes
+ self assert: (full includes: 5).
+ self assert: (full includes: #abc)!
+
+testOccurrences
+ self assert: (empty occurrencesOf: 0) = 0.
+ self assert: (full occurrencesOf: 5) = 1.
+ full add: 5.
+ self assert: (full occurrencesOf: 5) = 1!
+
+testRemove
+ full remove: 5.
+ self assert: (full includes: #abc).
+ self deny: (full includes: 5)! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Make.proto Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,201 @@
+# $Header: /cvs/stx/stx/goodies/sunit/Make.proto,v 1.1 2000-10-25 15:51:38 cg Exp $
+#
+# --- Make.proto created by stmkmp at Wed Oct 25 17:22:24 CEST 2000
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp again - otherwise, your changes are lost.
+#
+# The Makefile as generated by this Make.proto supports the following targets:
+# make - compile all st-files to a classLib
+# make install - install the classLib in /opt/smalltalk/...
+# make clean - clean all temp files
+# make clobber - clean all
+
+# module and directory-in-module;
+# these should correspond to the directory hierarchy
+# location (otherwise, ST/X will have a hard time to
+# find out the packages location from its packageID)
+MODULE=stx
+MODULE_DIR=goodies/sunit
+
+# default installation directory:
+# (overwrite with 'make INSTALLTOP_DIR=... install')
+# the INSTALLBASE is imported from configurations... and usually
+# defaults to something like /opt/smalltalk.
+# (overwrite with 'make INSTALLBASE=... install')
+INSTALLTOP_DIR=$(INSTALLBASE)/packages/$(MODULE)/$(MODULE_DIR)
+INSTALLLIB_DIR=$(INSTALLTOP_DIR)
+INSTALLBIN_DIR=$(INSTALLTOP_DIR)
+
+
+#
+# position (of this package) in directory hierarchy:
+# (must point to ST/X top directory, for tools and includes)
+TOP=../..
+
+# subdirectories where targets are to be made:
+SUBDIRS=
+
+# subdirectories where Makefiles are to be made:
+# (only define if different from SUBDIRS)
+# ALLSUBDIRS=
+
+
+# the name of your classLibrary:
+# ********** REQUIRED: CHECK the next line ***
+LIBNAME=sunit
+
+
+# the next define suppresses installation of
+# the classes as autoloaded (i.e. not added to abbrev.stc).
+SUPPRESS_LOCAL_ABBREVS=1
+
+
+# the package is stored as an ID in classes and methods
+# to identify code belonging to this project.
+# It also specifies the position in the source repository
+# and directory tree, when packages are loaded by packageID.
+# ********** REQUIRED: CHECK the next line ***
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler.
+# -H. : create header files locally
+# (if removed, they will be created as common
+# -Pxxx : defines the package
+# -Zxxx : a prefix for variables within the classLib
+# -Dxxx : defines passed to to CC for inline C-code
+# -Ixxx : include path passed to CC for inline C-code
+# +optspace : optimized for space
+# +optspace2 : optimized more for space
+# +optspace3 : optimized even more for space
+# +optinline : generate inline code for some ST constructs
+# +inlineNew : additionally inline new
+# +inlineMath : additionally inline some floatPnt math stuff
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
+# STCLOCALOPTIMIZATIONS=+optspace3
+STCLOCALOPTIMIZATIONS=+optspace3
+
+
+# Argument(s) to the stc compiler.
+# -warn : no warnings
+# -warnNonStandard : no warnings about ST/X extensions
+# -warnEOLComments : no warnings about EOL comment extension
+# -warnPrivacy : no warnings about privateClass extension
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=
+
+
+# if your embedded C code requires any system includes,
+# add the path(es) here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALINCLUDES=-Ifoo -Ibar
+LOCALINCLUDES=
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+
+#
+# The next 2 defines should be left as-is
+# for a class-library package, you can uncomment the following:
+# (it does not hurt much, if you leave it as is - but you may NOT
+# uncomment it if object files are to be loaded individually later).
+# INITCODESEPFLAG=$(SEPINITCODE)
+#
+# the following MAY ONLY be uncommented for classes/classLibs,
+# which are ALWAYS statically included in the executable.
+# (i.e. not for those which are subject to dynamic loading).
+# COMMONSYMFLAG=$(COMMONSYMBOLS)
+#
+STCLOCALOPT=-I. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALINCLUDES) $(LOCALDEFINES) -H. '-P$(PACKAGE)' '-Z$(LIBNAME)' $(COMMONSYMFLAG) $(INITCODESEPFLAG)
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C-libraries that should be pre-linked with the class-objects
+LD_OBJ_LIBS=
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C targets or libraries should be added below
+LOCAL_EXTRA_TARGETS=
+
+# if you use RCS, there are rules in the Makefile for ci/co
+RCSSOURCES=*.st Make.proto
+
+all:: preMake classLibRule postMake
+
+OBJS= \
+ TestCase.$(O) \
+ ExampleSetTest.$(O) \
+ SUnitDelay.$(O) \
+ SUnitNameResolver.$(O) \
+ SUnitTest.$(O) \
+ TestFailure.$(O) \
+ TestResult.$(O) \
+ TestRunner.$(O) \
+ TestSuite.$(O) \
+ TestSuitesHierarchyScriptTest.$(O) \
+ TestSuitesCompoundScriptTest.$(O) \
+ TestSuitesScriptTest.$(O) \
+ TestSuitesScripter.$(O) \
+ extensions.$(O)
+
+# add more install actions here
+install::
+
+# add more install actions for aux-files (resources) here
+installAux::
+
+# add more preMake actions here
+preMake::
+
+# add more postMake actions here
+postMake:: cleanjunk
+
+cleanjunk::
+
+clean::
+ -rm -f *.o *.H
+
+clobber::
+ -rm -f *.so *.dll
+
+$(INSTALLBASE)::
+ @test -d $@ || mkdir $@
+
+$(INSTALLBASE)/packages:: $(INSTALLBASE)
+ @test -d $@ || mkdir $@
+
+$(INSTALLBASE)/packages/$(MODULE):: $(INSTALLBASE)/packages
+ @test -d $@ || mkdir $@
+
+$(INSTALLBASE)/packages/$(MODULE)/goodies:: $(INSTALLBASE)/packages/$(MODULE)
+ @test -d $@ || mkdir $@
+
+$(INSTALLBASE)/packages/$(MODULE)/goodies/sunit:: $(INSTALLBASE)/packages/$(MODULE)/goodies
+ @test -d $@ || mkdir $@
+
+$(INSTALLBASE)/packages/$(MODULE)/$(MODULE_DIR):: $(INSTALLBASE)/packages/$(MODULE)
+ @test -d $@ || mkdir $@
+
+# if other things are to be compiled,
+# add target definitions here,
+# and list them in LOCAL_EXTRA_TARGETS above.
+# (care for make syntax - TABS are required in the actions)
+# foo: foo.o
+# $(CC) -o foo foo.o
+# 'make depend' will add dependency info between
+# BEGIN...END below
+#
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+# ENDMAKEDEPEND --- do not remove this line
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SUnitDelay.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,11 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:54 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Delay subclass:#SUnitDelay
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitPreload'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SUnitNameResolver.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,20 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:54 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#SUnitNameResolver
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitPreload'
+!
+
+!SUnitNameResolver class methodsFor:'Camp Smalltalk'!
+
+classNamed: aSymbol
+ ^Smalltalk at: aSymbol ifAbsent: [nil]
+
+ "Created: / 20.6.2000 / 18:20:42 / Sames"
+ "Modified: / 20.6.2000 / 18:20:50 / Sames"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SUnitTest.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,143 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:03 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+TestCase subclass:#SUnitTest
+ instanceVariableNames:'hasRun hasSetup hasRanOnce'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitTests'
+!
+
+!SUnitTest methodsFor:'Accessing'!
+
+hasRun
+ ^hasRun!
+
+hasSetup
+ ^hasSetup! !
+
+!SUnitTest methodsFor:'Private'!
+
+error
+ 3 zork
+
+ "Modified: / 21.6.2000 / 10:22:18 / Sames"
+!
+
+fail
+ self assert: false!
+
+noop!
+
+setRun
+ hasRun := true! !
+
+!SUnitTest methodsFor:'Running'!
+
+setUp
+ hasSetup := true! !
+
+!SUnitTest methodsFor:'Testing'!
+
+testAssert
+ self assert: true.
+ self deny: false!
+
+testDebugUI
+ "This should break"
+ 3 zork
+
+ "Modified: / 21.6.2000 / 10:22:50 / Sames"
+!
+
+testDefects
+ | result suite error failure |
+ suite := TestSuite new.
+ suite addTest: (error := self class selector: #error).
+ suite addTest: (failure := self class selector: #fail).
+ result := suite run.
+ self assert: result defects asArray = (Array with: error with: failure)
+
+ "Modified: / 21.6.2000 / 10:23:04 / Sames"
+!
+
+testDialectLocalizedException
+ self should: [TestResult signalFailureWith: 'Foo'] raise: TestResult failure.
+ self should: [TestResult signalErrorWith: 'Foo'] raise: TestResult error.
+ self shouldnt: [TestResult signalErrorWith: 'Foo'] raise: TestResult failure.
+
+ "Modified: / 21.6.2000 / 10:23:20 / Sames"
+!
+
+testError
+ | case result |
+ case := self class selector: #error.
+ result := case run.
+ self assert: result correctCount = 0.
+ self assert: result failureCount = 0.
+ self assert: result runCount = 1.
+ self assert: result errorCount = 1!
+
+testException
+ self should: [self error: 'foo'] raise: TestResult error
+
+ "Modified: / 21.6.2000 / 10:23:39 / Sames"
+!
+
+testFail
+ | case result |
+ case := self class selector: #fail.
+ result := case run.
+ self assert: result correctCount = 0.
+ self assert: result failureCount = 1.
+ self assert: result runCount = 1!
+
+testFailureDebugUI
+ "This should fail !!"
+ self fail!
+
+testIsNotRerunOnDebug
+ | case |
+ case := self class selector: #testRanOnlyOnce.
+ case run.
+ case debug!
+
+testRan
+ | case |
+ case := self class selector: #setRun.
+ case run.
+ self assert: case hasSetup.
+ self assert: case hasRun!
+
+testRanOnlyOnce
+ self assert: hasRanOnce ~= true.
+ hasRanOnce := true.!
+
+testResult
+ | case result |
+ case := self class selector: #noop.
+ result := case run.
+ self assert: result runCount = 1.
+ self assert: result correctCount = 1!
+
+testRunning
+ (SUnitDelay forSeconds: 2) wait
+
+ "Modified: / 21.6.2000 / 10:24:41 / Sames"
+!
+
+testShould
+ self should: [true].
+ self shouldnt: [false]!
+
+testSuite
+ | suite result |
+ suite := TestSuite new.
+ suite addTest: (self class selector: #noop).
+ suite addTest: (self class selector: #fail).
+ result := suite run.
+ self assert: result runCount = 2.
+ self assert: result correctCount = 1.
+ self assert: result failureCount = 1! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestCase.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,147 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:32 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestCase
+ instanceVariableNames:'testSelector'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit'
+!
+
+!TestCase class methodsFor:'Instance Creation'!
+
+debug: aSymbol
+ ^(self selector: aSymbol) debug!
+
+run: aSymbol
+ ^(self selector: aSymbol) run!
+
+selector: aSymbol
+ ^self new setTestSelector: aSymbol!
+
+suite
+ | testSelectors result |
+ testSelectors := self sunitSelectors select: [:each | 'test*' sunitMatch: each].
+ result := TestSuite new.
+ testSelectors do: [:each | result addTest: (self selector: each)].
+ ^result
+
+ "Modified: / 21.6.2000 / 10:05:24 / Sames"
+! !
+
+!TestCase methodsFor:'Accessing'!
+
+assert: aBoolean
+ aBoolean ifFalse: [self signalFailure: 'Assertion failed']
+
+ "Modified: / 21.6.2000 / 10:00:05 / Sames"
+!
+
+deny: aBoolean
+ self assert: aBoolean not!
+
+should: aBlock
+ self assert: aBlock value!
+
+should: aBlock raise: anExceptionalEvent
+ ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
+
+ "Modified: / 21.6.2000 / 10:01:08 / Sames"
+!
+
+shouldnt: aBlock
+ self deny: aBlock value!
+
+shouldnt: aBlock raise: anExceptionalEvent
+ ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
+
+ "Modified: / 21.6.2000 / 10:01:16 / Sames"
+!
+
+signalFailure: aString
+ TestResult failure sunitSignalWith: aString
+
+ "Modified: / 21.6.2000 / 10:01:34 / Sames"
+! !
+
+!TestCase methodsFor:'Dependencies'!
+
+addDependentToHierachy: anObject
+ "an empty method. for Composite compability with TestSuite"!
+
+removeDependentFromHierachy: anObject
+ "an empty method. for Composite compability with TestSuite"! !
+
+!TestCase methodsFor:'Printing'!
+
+printOn: aStream
+ aStream nextPutAll: self class name.
+ aStream nextPutAll: '>>'.
+ aStream nextPutAll: testSelector
+
+ "Modified: / 4.4.2000 / 18:59:53 / Sames"
+! !
+
+!TestCase methodsFor:'Private'!
+
+executeShould: aBlock inScopeOf: anExceptionalEvent
+ [[aBlock value]
+ sunitOn: anExceptionalEvent
+ do: [:ex | ^true]]
+ sunitOn: TestResult error
+ do: [:ex | ^false].
+ ^false.
+
+ "Modified: / 21.6.2000 / 10:03:03 / Sames"
+!
+
+setTestSelector: aSymbol
+ testSelector := aSymbol! !
+
+!TestCase methodsFor:'Running'!
+
+debug
+ (self class selector: testSelector) runCase!
+
+debugAsFailure
+ (self class selector: testSelector) runCaseAsFailure!
+
+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"
+
+ self halt.
+ self perform: testSelector sunitAsSymbol
+
+ "Modified: / 21.6.2000 / 10:03:37 / Sames"
+!
+
+run
+ | result |
+ result := TestResult new.
+ self run: result.
+ ^result!
+
+run: aResult
+ aResult runCase: self!
+
+runCase
+ self setUp.
+ [self perform: testSelector sunitAsSymbol] sunitEnsure: [self tearDown]
+
+ "Modified: / 21.6.2000 / 10:04:18 / Sames"
+!
+
+runCaseAsFailure
+ self setUp.
+ [[self openDebuggerOnFailingTestMethod] sunitEnsure: [self tearDown]] fork
+
+ "Modified: / 21.6.2000 / 10:04:33 / Sames"
+!
+
+setUp!
+
+tearDown! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestFailure.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,11 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:54 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Exception subclass:#TestFailure
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitPreload'
+!
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestResult.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,134 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:32 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestResult
+ instanceVariableNames:'runCount failures errors'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit'
+!
+
+!TestResult class methodsFor:'Exceptions'!
+
+error
+ ^self exError
+
+ "Modified: / 21.6.2000 / 10:07:16 / Sames"
+!
+
+exError
+ "Change for Dialect"
+ ^Error
+
+ "Modified: / 21.6.2000 / 10:10:45 / Sames"
+!
+
+failure
+ ^TestFailure
+
+ "Modified: / 21.6.2000 / 10:07:03 / Sames"
+!
+
+signalErrorWith: aString
+ self error sunitSignalWith: aString
+
+ "Modified: / 21.6.2000 / 10:11:07 / Sames"
+!
+
+signalFailureWith: aString
+ self failure sunitSignalWith: aString
+
+ "Modified: / 21.6.2000 / 10:11:20 / Sames"
+! !
+
+!TestResult class methodsFor:'Init / Release'!
+
+new
+ ^super new initialize
+
+ "Modified: / 21.6.2000 / 10:11:50 / Sames"
+! !
+
+!TestResult methodsFor:'Accessing'!
+
+correctCount
+ ^self runCount - self failureCount - self errorCount
+
+ "Modified: / 21.6.2000 / 10:07:48 / Sames"
+!
+
+defects
+ ^self errors, self failures
+
+ "Modified: / 21.6.2000 / 10:07:56 / Sames"
+!
+
+errorCount
+ ^self errors size!
+
+errors
+ errors isNil ifTrue: [errors := OrderedCollection new].
+ ^errors!
+
+failureCount
+ ^self failures size
+
+ "Modified: / 21.6.2000 / 10:08:34 / Sames"
+!
+
+failures
+ failures isNil ifTrue: [failures := OrderedCollection new].
+ ^failures!
+
+runCount
+ ^runCount! !
+
+!TestResult methodsFor:'Init / Release'!
+
+initialize
+ runCount := 0! !
+
+!TestResult methodsFor:'Printing'!
+
+printOn: aStream
+ aStream
+ nextPutAll: self runCount printString;
+ nextPutAll: ' run, ';
+ nextPutAll: self failureCount printString;
+ nextPutAll: ' failed, ';
+ nextPutAll: self errorCount printString;
+ nextPutAll:' error'.
+ self errorCount ~= 1
+ ifTrue: [aStream nextPut: $s].
+
+ "Created: / 21.6.2000 / 10:09:12 / Sames"
+! !
+
+!TestResult methodsFor:'Running'!
+
+runCase: aTestCase
+ runCount := runCount + 1.
+ [[aTestCase runCase]
+ sunitOn: self class failure
+ do:
+ [:signal |
+ self failures add: aTestCase.
+ signal sunitExitWith: nil]]
+ sunitOn: self class error
+ do:
+ [:signal |
+ self errors add: aTestCase.
+ signal sunitExitWith: nil]
+
+ "Modified: / 21.6.2000 / 10:10:06 / Sames"
+! !
+
+!TestResult methodsFor:'Testing'!
+
+hasPassed
+ ^self runCount = self correctCount!
+
+isFailure: aTestCase
+ ^self failures includes: aTestCase! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestRunner.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,527 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:11 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+ApplicationModel subclass:#TestRunner
+ instanceVariableNames:'result lastPass defect allDefects defectMenu details mode
+ scriptModel script'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitUI'
+!
+
+!TestRunner class methodsFor:'interface specs'!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:TestRunner andSelector:#windowSpec
+ TestRunner new openInterface:#windowSpec
+ TestRunner open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'SUnit Camp Smalltalk 2.7 TestRunner'
+ #name: 'SUnit Camp Smalltalk 2.7 TestRunner'
+ #min: #(#Point 362 122)
+ #bounds: #(#Rectangle 16 46 509 221)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#ActionButtonSpec
+ #label: 'Refresh'
+ #name: 'Button3'
+ #layout: #(#LayoutFrame 0 0 0 0 75 0 24 0)
+ #model: #refreshSuites
+ )
+ #(#MenuButtonSpec
+ #label: 'ExampleSetTest'
+ #name: #tests
+ #layout: #(#LayoutFrame 76 0 0 0 -146 1 24 0)
+ #model: #script
+ #menu: #scriptModel
+ #useIndex: true
+ )
+ #(#ActionButtonSpec
+ #label: 'Run'
+ #name: 'Button1'
+ #layout: #(#LayoutFrame -145 1 0 0 -77 1 24 0)
+ #model: #runTests
+ #enableChannel: #enableRunButton
+ )
+ #(#ActionButtonSpec
+ #label: 'RunAll'
+ #name: 'Button2'
+ #layout: #(#LayoutFrame -76 1 0 0 0 1 24 0)
+ #model: #runAllTests
+ )
+ #(#LabelSpec
+ #label: 'N/A'
+ #name: 'mode'
+ #layout: #(#LayoutFrame 0 0 25 0 0 1 0 0.5)
+ #style: #(#FontDescription #Arial #bold #roman 14)
+ #labelChannel: #mode
+ )
+ #(#LabelSpec
+ #label: '...'
+ #name: 'details'
+ #layout: #(#LayoutFrame 0 0 0 0.5 0 1 -24 1)
+ #labelChannel: #details
+ )
+ #(#MenuButtonSpec
+ #name: #defects
+ #layout: #(#LayoutFrame 0 0 -24 1 -75 1 0 1)
+ #isOpaque: true
+ #flags: 40
+ #model: #selectionHolder
+ #initiallyDisabled: true
+ #enableChannel: #enableDefectsList
+ #menu: #defectMenu
+ )
+ #(#ActionButtonSpec
+ #label: 'Debug'
+ #name: 'Button4'
+ #layout: #(#LayoutFrame -75 1 -24 1 0 1 0 1)
+ #model: #debugSelectedFailure
+ #initiallyDisabled: true
+ #enableChannel: #enableDebugButton
+ )
+ )
+
+ )
+ )
+! !
+
+!TestRunner class methodsFor:'opening'!
+
+open
+
+ ^super open! !
+
+!TestRunner class methodsFor:'plugIn spec'!
+
+aspectSelectors
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this. If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "Return a description of exported aspects;
+ these can be connected to aspects of an embedding application
+ (if this app is embedded in a subCanvas)."
+
+ ^ #(
+ #script
+ ).
+
+! !
+
+!TestRunner methodsFor:'Accessing'!
+
+defectMenu
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ ^defectMenu isNil
+ ifTrue: [defectMenu := OrderedCollection new asValue]
+ ifFalse: [defectMenu]
+
+ "Modified: / 4.4.2000 / 20:00:31 / Sames"
+!
+
+defects
+
+ ^self builder componentAt: #defects
+
+ "Created: / 21.6.2000 / 12:19:29 / Sames"
+!
+
+details
+ "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."
+
+ ^details isNil
+ ifTrue:
+ [details := '...' asValue]
+ ifFalse:
+ [details]!
+
+mode
+ "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."
+
+ ^mode isNil
+ ifTrue:
+ [mode := 'N/A' asValue]
+ ifFalse:
+ [mode]!
+
+script
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ |holder|
+
+ (holder := builder bindingAt:#script) isNil ifTrue:[
+ holder := ValueHolder new.
+ builder aspectAt:#script put:holder.
+"/ holder addDependent:self.
+ ].
+ ^ holder.
+
+ "Created: / 21.6.2000 / 12:04:36 / Sames"
+!
+
+script:something
+ "automatically generated by UIPainter ..."
+
+ "This method is used when I am embedded as subApplication,"
+ "and the mainApp wants to connect its aspects to mine."
+
+"/ |holder|
+
+"/ (holder := builder bindingAt:#script) notNil ifTrue:[
+"/ holder removeDependent:self.
+"/ ].
+ builder aspectAt:#script put:something.
+"/ something notNil ifTrue:[
+"/ something addDependent:self.
+"/ ].
+ ^ self.
+
+ "Created: / 21.6.2000 / 12:04:36 / Sames"
+!
+
+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."
+
+ ^scriptModel isNil
+ ifTrue: [scriptModel := (TestCase allSubclasses collect: [:each | each name]) asValue]
+ ifFalse: [scriptModel]
+
+ "Modified: / 2.4.2000 / 14:37:51 / Sames"
+!
+
+selection
+
+ ^defect
+
+ "Created: / 4.4.2000 / 18:50:55 / Sames"
+!
+
+selectionHolder
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ |holder|
+
+ (holder := builder bindingAt:#selectionHolder) isNil ifTrue:[
+ holder := AspectAdaptor new subject:self; forAspect:#selection.
+ builder aspectAt:#selectionHolder put:holder.
+"/ holder addDependent:self.
+ ].
+ ^ holder.
+
+ "Created: / 4.4.2000 / 18:46:08 / Sames"
+ "Modified: / 4.4.2000 / 18:47:31 / Sames"
+!
+
+tests
+
+ ^self builder componentAt: #tests
+
+ "Created: / 4.4.2000 / 19:57:37 / Sames"
+! !
+
+!TestRunner methodsFor:'Actions'!
+
+debugSelectedFailure
+ self debugTest: self selection
+
+ "Created: / 21.6.2000 / 10:58:58 / Sames"
+ "Modified: / 21.6.2000 / 12:21:05 / Sames"
+!
+
+debugTest: aTestCaseName
+ | testCase |
+ defect := aTestCaseName.
+ testCase := allDefects at: aTestCaseName ifAbsent: [nil].
+ testCase isNil ifTrue: [^self enableDebugButton value: false].
+ self enableDebugButton value: true.
+ self displayMode: 'Debugging'.
+ (result isFailure: testCase)
+ ifTrue: [testCase debugAsFailure]
+ ifFalse: [testCase debug]
+
+ "Modified: / 21.6.2000 / 12:12:09 / Sames"
+!
+
+enableDebugButton
+ "automatically generated by UIPainter ..."
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ | holder |
+ (holder := builder bindingAt: #enableDebugButton) isNil
+ ifTrue:
+ [holder := true asValue.
+ builder aspectAt: #enableDebugButton put: holder
+ " holder addDependent:self."].
+ ^holder
+
+ "Created: / 21.6.2000 / 10:47:34 / Sames"
+ "Modified: / 21.6.2000 / 10:51:07 / Sames"
+!
+
+enableDefectsList
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ |holder|
+
+ (holder := builder bindingAt:#enableDefectsList) isNil ifTrue:[
+ holder := true asValue.
+ builder aspectAt:#enableDefectsList put:holder.
+"/ holder addDependent:self.
+ ].
+ ^ holder.
+
+ "Created: / 21.6.2000 / 10:47:34 / Sames"
+!
+
+enableRunButton
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+
+ |holder|
+
+ (holder := builder bindingAt:#enableRunButton) isNil ifTrue:[
+ holder := true asValue.
+ builder aspectAt:#enableRunButton put:holder.
+"/ holder addDependent:self.
+ ].
+ ^ holder.
+
+ "Created: / 21.6.2000 / 10:47:34 / Sames"
+!
+
+refreshSuites
+ self scriptModel value: (TestCase allSubclasses collect: [:each | each name]).
+ self tests selection: 0.
+ self defects selection: 0.
+ result := TestResult new.
+ self displayRefresh
+
+ "Created: / 21.6.2000 / 10:58:34 / Sames"
+ "Modified: / 21.6.2000 / 12:19:54 / Sames"
+!
+
+runAllTests
+ self runSuite: self allTestSuite!
+
+runSuite: aTestSuite
+ Cursor wait
+ showWhile:
+ [self displayRunning.
+ aTestSuite addDependentToHierachy: self.
+ [result := aTestSuite run]
+ ensure: [aTestSuite removeDependentFromHierachy: self].
+ self updateWindow]!
+
+runTests
+ | testSuite |
+ (testSuite := self freshTestSuite) notNil ifTrue:
+ [self runSuite: testSuite]
+
+ "Modified: / 2.4.2000 / 14:16:10 / Sames"
+!
+
+selection: aValue
+
+ self debugTest: aValue
+
+ "Created: / 4.4.2000 / 18:54:09 / Sames"
+ "Modified: / 4.4.2000 / 19:01:33 / Sames"
+!
+
+suiteSelectionChanged
+ self enableRunButton value: self freshTestSuite notNil
+
+ "Created: / 21.6.2000 / 11:31:25 / Sames"
+ "Modified: / 21.6.2000 / 11:32:54 / Sames"
+! !
+
+!TestRunner methodsFor:'Private'!
+
+allTestSuite
+ | tokens stream |
+ tokens := (TestCase subclasses collect: [:each | each name , '* '])
+ copyWithout: 'SUnitTest* '.
+ stream := WriteStream on: String new.
+ tokens do: [:each | stream nextPutAll: each].
+ ^TestSuitesScripter run: stream contents!
+
+formatTime: aTime
+ aTime hours > 0 ifTrue: [^aTime hours printString , 'h'].
+ aTime minutes > 0 ifTrue: [^aTime minutes printString , 'min'].
+ ^aTime seconds printString , ' sec'!
+
+freshTestSuite
+
+ ^TestSuitesScripter run: self tests contents
+
+ "Modified: / 4.4.2000 / 20:13:41 / Sames"
+!
+
+postOpenWith: aBuilder
+ "automatically generated by UIPainter ..."
+
+ super postOpenWith: aBuilder.
+ self tests defaultLabel: ''.
+ self tests selection: 'ExampleSetTest'.
+ self enableDebugButton value: false.
+ self enableDefectsList value: false.
+ self script onChangeSend: #suiteSelectionChanged to: self
+
+ "Created: / 2.4.2000 / 14:44:32 / Sames"
+ "Modified: / 21.6.2000 / 12:06:30 / Sames"
+!
+
+timeSinceLastPassAsString
+ lastPass isNil ifTrue: [^''].
+ ^', ' , (self formatTime: (Time now subtractTime: lastPass getSeconds)) , ' since last Pass'
+
+ "Modified: / 3.4.2000 / 19:17:11 / Sames"
+! !
+
+!TestRunner methodsFor:'Updating'!
+
+displayColor: aColorValue
+
+ (builder componentAt: #mode) widget insideColor: aColorValue.
+ (builder componentAt: #details) widget insideColor: aColorValue.
+
+ "Modified: / 2.4.2000 / 14:21:42 / Sames"
+!
+
+displayDefault
+ self displayColor: self tests backgroundColor
+
+ "Created: / 21.6.2000 / 12:28:06 / Sames"
+ "Modified: / 21.6.2000 / 12:35:09 / Sames"
+!
+
+displayDefects: aCollection
+ | menuButton |
+ menuButton := self builder componentAt: #defects.
+ aCollection isEmpty ifTrue: [^menuButton disable].
+ allDefects := Dictionary new.
+ aCollection do: [:each | allDefects at: each printString put: each].
+ self defectMenu value: allDefects keys asOrderedCollection.
+ menuButton enable
+
+ "Modified: / 4.4.2000 / 20:11:06 / Sames"
+!
+
+displayDetails: aString
+ self details value: aString.
+
+ "Modified: / 21.6.2000 / 11:10:14 / Sames"
+!
+
+displayFail
+ self displayRed.
+ self displayMode: 'Fail'.
+ self displayDetails: result printString.!
+
+displayGreen
+ self displayColor: ColorValue green!
+
+displayMode: aString
+ self mode value: aString
+
+ "Modified: / 21.6.2000 / 11:14:19 / Sames"
+!
+
+displayPass
+ self displayMode: 'Pass'.
+ self displayDetails: result runCount printString , ' run' , self timeSinceLastPassAsString.
+ self displayGreen.
+ lastPass := Time now
+
+ "Modified: / 21.6.2000 / 12:14:52 / Sames"
+!
+
+displayRed
+ self displayColor: ColorValue red.!
+
+displayRefresh
+ self displayMode: 'N/A'.
+ self displayDetails:'...'.
+ self updateDefects.
+ self enableRunButton value: false.
+ self enableDebugButton value: false.
+ self displayDefault
+
+ "Created: / 21.6.2000 / 12:14:11 / Sames"
+ "Modified: / 21.6.2000 / 12:28:24 / Sames"
+!
+
+displayRunning
+ self displayYellow.
+ self displayMode: 'running'.
+ self displayDetails: '...'.!
+
+displayYellow
+ self displayColor: ColorValue yellow!
+
+update: anObject
+ (anObject isKindOf: TestCase)
+ ifTrue: [self displayDetails: anObject printString]
+ ifFalse: [super update: anObject]!
+
+updateDefects
+ self displayDefects: result defects!
+
+updateWindow
+ result hasPassed
+ ifTrue: [self displayPass]
+ ifFalse: [self displayFail].
+ self updateDefects! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestSuite.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,56 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:32 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestSuite
+ instanceVariableNames:'tests'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit'
+!
+
+!TestSuite methodsFor:'Accessing'!
+
+addTest: aTest
+ self tests add: aTest!
+
+addTests: aCollection
+ aCollection do: [:eachTest | self addTest: eachTest]!
+
+tests
+ tests isNil ifTrue: [tests := OrderedCollection new].
+ ^tests! !
+
+!TestSuite methodsFor:'Dependencies'!
+
+addDependentToHierachy: anObject
+ self sunitAddDependent: anObject.
+ self tests do: [:each | each addDependentToHierachy: anObject]
+
+ "Modified: / 21.6.2000 / 10:13:35 / Sames"
+!
+
+removeDependentFromHierachy: anObject
+ self sunitRemoveDependent: anObject.
+ self tests do: [:each | each removeDependentFromHierachy: anObject]
+
+ "Modified: / 21.6.2000 / 10:13:27 / Sames"
+! !
+
+!TestSuite methodsFor:'Running'!
+
+run
+ | result |
+ result := TestResult new.
+ self run: result.
+ ^result!
+
+run: aResult
+ self tests do:
+ [:each |
+ self sunitChanged: each.
+ each run: aResult]
+
+ "Modified: / 21.6.2000 / 10:14:01 / Sames"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestSuitesCompoundScriptTest.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,16 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:03 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+TestSuitesHierarchyScriptTest subclass:#TestSuitesCompoundScriptTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitTests'
+!
+
+!TestSuitesCompoundScriptTest methodsFor:'Testing'!
+
+testRan
+ super testRan! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestSuitesHierarchyScriptTest.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,19 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:03 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+SUnitTest subclass:#TestSuitesHierarchyScriptTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitTests'
+!
+
+!TestSuitesHierarchyScriptTest methodsFor:'Testing'!
+
+testRan
+ self setRun
+
+ "Modified: / 21.6.2000 / 10:25:38 / Sames"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestSuitesScriptTest.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,103 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:11:03 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+SUnitTest subclass:#TestSuitesScriptTest
+ instanceVariableNames:'scripter suite'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnitTests'
+!
+
+!TestSuitesScriptTest methodsFor:'Running'!
+
+setUp
+ scripter := TestSuitesScripter new.! !
+
+!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 sunitName sunitAsSymbol = #TestSuitesHierarchyScriptTest.
+ subCase := (allTestCaseClasses at: 2) tests first.
+ self assert: subCase class sunitName sunitAsSymbol = #TestSuitesCompoundScriptTest.
+
+ "Modified: / 21.6.2000 / 10:26:48 / Sames"
+!
+
+testEmbeddedNameCommentScript
+ suite := scripter run: ' "This comment contains the name of a SUnitTest Case" TestSuitesScriptTest'.
+ self assert: suite tests size = 1
+
+ "Modified: / 21.6.2000 / 10:27:02 / Sames"
+!
+
+testEmptyCommentScript
+ suite := scripter run: ' " " TestSuitesScriptTest'.
+ self assert: suite tests size = 1
+
+ "Modified: / 21.6.2000 / 10:27:14 / Sames"
+!
+
+testEmptyHierachyScript
+ suite := scripter run: '*'.
+ self assert: suite tests isEmpty
+
+ "Modified: / 21.6.2000 / 10:27:24 / Sames"
+!
+
+testEmptyScript
+ suite := scripter run: ''.
+ self assert: suite tests isEmpty
+
+ "Modified: / 21.6.2000 / 10:27:39 / Sames"
+!
+
+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 sunitName sunitAsSymbol = #TestSuitesHierarchyScriptTest.
+ subCase := (allTestCaseClasses first tests at: 2) tests first.
+ self assert: subCase class sunitName sunitAsSymbol = #TestSuitesCompoundScriptTest.
+
+ "Modified: / 21.6.2000 / 10:28:02 / Sames"
+!
+
+testOpenCommentScript
+ suite := scripter run: ' "SUnitTest'.
+ self assert: suite tests isEmpty
+
+ "Modified: / 21.6.2000 / 10:28:18 / Sames"
+!
+
+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 sunitName sunitAsSymbol = #TestSuitesHierarchyScriptTest.
+
+ "Modified: / 21.6.2000 / 10:28:35 / Sames"
+!
+
+testSingleWordCommentScript
+ suite := scripter run: ' "SUnitTest" TestSuitesScriptTest'.
+ self assert: suite tests size = 1
+
+ "Modified: / 21.6.2000 / 10:28:47 / Sames"
+!
+
+testTwoCommentsScript
+ suite := scripter run: ' " SUnitTest " " SUnitTest " TestSuitesScriptTest'.
+ self assert: suite tests size = 1
+
+ "Modified: / 21.6.2000 / 10:28:59 / Sames"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TestSuitesScripter.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,112 @@
+'From Smalltalk/X, Version:4.1.1 on 24-oct-2000 at 08:10:32 pm' !
+
+"{ Package: 'stx:goodies/sunit' }"
+
+Object subclass:#TestSuitesScripter
+ instanceVariableNames:'script stream'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SUnit'
+!
+
+!TestSuitesScripter class methodsFor:'Example'!
+
+exampleScripting
+ ^(TestSuitesScripter script: ' "scratch suite 3" ExampleSetTest SUnitTest* ') value
+
+ "Modified: / 21.6.2000 / 10:18:08 / Sames"
+! !
+
+!TestSuitesScripter class methodsFor:'Init / Release'!
+
+run: aString
+ ^self new run: aString!
+
+script: aString
+ ^self new setScript: aString! !
+
+!TestSuitesScripter methodsFor:'Printing'!
+
+printOn: aStream
+ aStream nextPutAll: (script isNil
+ ifFalse: [script]
+ ifTrue: ['N/A'])
+
+ "Created: / 21.6.2000 / 10:15:29 / Sames"
+! !
+
+!TestSuitesScripter methodsFor:'Private'!
+
+executeSingleSuiteScript: aString
+ | useHierachy realName testCase |
+ aString last = $*
+ ifTrue:
+ [realName := aString copyFrom: 1 to: aString size - 1.
+ useHierachy := true]
+ ifFalse:
+ [realName := aString.
+ useHierachy := false].
+ realName isEmpty ifTrue: [^nil].
+ testCase := SUnitNameResolver classNamed: realName sunitAsSymbol.
+ testCase isNil ifTrue: [^nil].
+ ^useHierachy
+ ifTrue: [self hierachyOfTestSuitesFrom: testCase]
+ ifFalse: [testCase suite]
+
+ "Modified: / 21.6.2000 / 10:16:02 / Sames"
+!
+
+getNextToken
+ [stream atEnd not and: [stream peek first = $"]] whileTrue: [self skipComment].
+ ^stream atEnd not
+ ifTrue: [stream next]
+ ifFalse: [nil]
+
+ "Modified: / 21.6.2000 / 10:16:16 / Sames"
+!
+
+hierachyOfTestSuitesFrom: aTestCase
+ | subSuite |
+ subSuite := TestSuite new.
+ subSuite addTest: aTestCase suite.
+ aTestCase allSubclasses do: [:each | subSuite addTest: each sunitName sunitAsSymbol sunitAsClass suite].
+ ^subSuite
+
+ "Modified: / 21.6.2000 / 10:16:29 / Sames"
+!
+
+setScript: aString
+ script := aString!
+
+skipComment
+ | token inComment |
+ token := stream next.
+ token size > 1 & (token last = $") ifTrue: [^nil].
+ inComment := true.
+ [inComment & stream atEnd not]
+ whileTrue:
+ [token := stream next.
+ token last = $" ifTrue: [inComment := false]]
+
+ "Modified: / 21.6.2000 / 10:16:47 / Sames"
+! !
+
+!TestSuitesScripter methodsFor:'Scripting'!
+
+run: aString
+ | suite subSuite token |
+ suite := TestSuite new.
+ stream := ReadStream on: aString sunitSubStrings.
+ [stream atEnd] whileFalse:
+ [token := self getNextToken.
+ token notNil ifTrue: [
+ subSuite := self executeSingleSuiteScript: token.
+ subSuite notNil ifTrue:[suite addTest: subSuite]]].
+ ^suite
+
+ "Modified: / 21.6.2000 / 10:17:11 / Sames"
+!
+
+value
+ ^self run: script! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/abbrev.stc Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,13 @@
+ExampleSetTest ExampleSetTest stx:goodies/sunit 'SUnitTests'
+SUnitDelay SUnitDelay stx:goodies/sunit 'SUnitPreload'
+SUnitNameResolver SUnitNameResolver stx:goodies/sunit 'SUnitPreload'
+SUnitTest SUnitTest stx:goodies/sunit 'SUnitTests'
+TestCase TestCase stx:goodies/sunit 'SUnit'
+TestFailure TestFailure stx:goodies/sunit 'SUnitPreload'
+TestResult TestResult stx:goodies/sunit 'SUnit'
+TestRunner TestRunner stx:goodies/sunit 'SUnitUI'
+TestSuite TestSuite stx:goodies/sunit 'SUnit'
+TestSuitesCompoundScriptTest TestSuitesCompoundScriptTest stx:goodies/sunit 'SUnitTests'
+TestSuitesHierarchyScriptTest TestSuitesHierarchyScriptTest stx:goodies/sunit 'SUnitTests'
+TestSuitesScriptTest TestSuitesScriptTest stx:goodies/sunit 'SUnitTests'
+TestSuitesScripter TestSuitesScripter stx:goodies/sunit 'SUnit'
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/extensions.st Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,108 @@
+"{ Package: 'stx:goodies/sunit' }" !
+
+!Class methodsFor:'Camp Smalltalk'!
+
+sunitName
+ ^self name
+
+ "Created: / 20.6.2000 / 12:32:46 / Sames"
+! !
+
+!Behavior methodsFor:'Camp Smalltalk'!
+
+sunitSelectors
+ ^self selectors asSortedCollection asOrderedCollection
+
+ "Created: / 20.6.2000 / 11:54:54 / Sames"
+! !
+
+!Block methodsFor:'Camp Smalltalk'!
+
+sunitEnsure: aBlock
+ ^self valueNowOrOnUnwindDo: aBlock
+
+ "Created: / 20.6.2000 / 11:59:32 / Sames"
+ "Modified: / 20.6.2000 / 12:27:10 / Sames"
+! !
+
+!Block methodsFor:'Camp Smalltalk'!
+
+sunitOn: aSignal do: anExceptionBlock
+ ^self on: aSignal do: anExceptionBlock
+
+ "Created: / 20.6.2000 / 12:27:57 / Sames"
+! !
+
+!String methodsFor:'Camp Smalltalk'!
+
+sunitAsSymbol
+ ^self asSymbol
+
+ "Created: / 20.6.2000 / 18:06:20 / Sames"
+! !
+
+!String methodsFor:'Camp Smalltalk'!
+
+sunitMatch: aString
+ ^self match: aString
+
+ "Created: / 20.6.2000 / 18:10:34 / Sames"
+! !
+
+!String methodsFor:'Camp Smalltalk'!
+
+sunitSubStrings
+ ^self asArrayOfSubstrings
+
+ "Modified: / 20.6.2000 / 18:11:54 / Sames"
+! !
+
+!Object methodsFor:'Camp Smalltalk'!
+
+sunitAddDependent: anObject
+ self addDependent: anObject
+
+ "Created: / 20.6.2000 / 17:56:27 / Sames"
+! !
+
+!Object methodsFor:'Camp Smalltalk'!
+
+sunitChanged: aspect
+ self changed: aspect
+
+ "Created: / 20.6.2000 / 17:57:48 / Sames"
+! !
+
+!Object methodsFor:'Camp Smalltalk'!
+
+sunitRemoveDependent: anObject
+ self removeDependent: anObject
+
+ "Created: / 20.6.2000 / 17:58:13 / Sames"
+! !
+
+!Symbol methodsFor:'Camp Smalltalk'!
+
+sunitAsClass
+ ^SUnitNameResolver classNamed: self
+
+ "Created: / 20.6.2000 / 18:22:33 / Sames"
+! !
+
+!GenericException methodsFor:'Camp Smalltalk'!
+
+sunitExitWith: aValue
+ ^self returnWith: aValue
+
+ "Created: / 20.6.2000 / 12:34:54 / Sames"
+ "Modified: / 20.6.2000 / 12:37:21 / Sames"
+! !
+
+!GenericException class methodsFor:'Camp Smalltalk'!
+
+sunitSignalWith: aString
+ ^self raiseErrorString: aString
+
+ "Created: / 20.6.2000 / 12:40:52 / Sames"
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/libInit.cc Wed Oct 25 17:51:59 2000 +0200
@@ -0,0 +1,39 @@
+/*
+ * DO NOT EDIT
+ * automatically generated from Make.proto (by make libInit.cc)
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+#define INIT_TEXT_SECT /* as nothing */
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#else /* not WIN32 */
+# if defined(__GNUC__) && !defined(NO_SECTION_ATTRIBUTES)
+# if (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) || __GNUC__ > 2
+# undef INIT_TEXT_SECT
+# define INIT_TEXT_SECT __attribute__((section(".stxitext")))
+# endif
+# endif /* not GNUC */
+#endif /* not WIN32 */
+#ifdef INIT_TEXT_SECT
+extern void _sunit_Init() INIT_TEXT_SECT;
+#endif
+void _sunit_Init(pass, __pRT__, snd)
+OBJ snd; struct __vmData__ *__pRT__; {
+__BEGIN_PACKAGE2__("sunit", _sunit_Init, "stx:goodies/sunit");
+_TestCase_Init(pass,__pRT__,snd);
+_ExampleSetTest_Init(pass,__pRT__,snd);
+_SUnitDelay_Init(pass,__pRT__,snd);
+_SUnitNameResolver_Init(pass,__pRT__,snd);
+_SUnitTest_Init(pass,__pRT__,snd);
+_TestFailure_Init(pass,__pRT__,snd);
+_TestResult_Init(pass,__pRT__,snd);
+_TestRunner_Init(pass,__pRT__,snd);
+_TestSuite_Init(pass,__pRT__,snd);
+_TestSuitesHierarchyScriptTest_Init(pass,__pRT__,snd);
+_TestSuitesCompoundScriptTest_Init(pass,__pRT__,snd);
+_TestSuitesScriptTest_Init(pass,__pRT__,snd);
+_TestSuitesScripter_Init(pass,__pRT__,snd);
+_extensions_Init(pass,__pRT__,snd);
+__END_PACKAGE__();
+}