Minitest.ns

Newspeak3
'Root'
class Minitest usingPlatform: platform = (
(* Minitest is the unit testing framework of Newspeak. 

Users familiar with SUnit should note that Minitest is not an SUnit port or clone, but rather a complete redesign that revises the core structures and mechanisms to simplify test definitions and to make use of language facilities unique to Newspeak.

CORE CLASSES

Most of the classes defined by this module are internal to its implementation and are not intended to be subclassed or directly instantiated by the framework users. SUnit users, note: this includes the class named TestCase! The only class the typical test writer imports and subclasses is TestContext. A developer working on IDE tools may also need access to TestCatalog and Tester.

BASIC TESTS

Defining tests begins with defining the test module--a top-level class to hold everything else. As the arguments, the factory of a test module typically takes an instance of the Newspeak platform, an instance of the Minitest module, and the factory or factories that create the tested object(s).

	class ListTesting usingPlatform: platform minitest: minitest listClass: listClass = (
	|
	private TestContext = minitest TestContext.
	private List = listClass.
	|
	...

The actual tests are defined as methods of a test context, a subclass of TestContext nested inside the test module.

	( * nested inside MyCollectionsTest * )
	class ListTests = TestContext (
	| list = List new. |
	) (
	public testAddition = (
	  list add: 1.
	  assert: (list includes: 1)
	)
	public testRemoval = (
	  list add: 1; remove: 1.
	  deny: (list includes: 1)
	)
	) : (
	TEST_CONTEXT = ()
	)

This test context defines two test methods, recognized as such because they begin with the word 'test'. To run each of those, the framework will create a fresh instance of the ListTests class and send it the message required to invoke the method. A separate instance is created to run each of the test methods in a test context, so the List used by testRemoval is different from the one used by testAddition.

Note the empty class-side method named TEST_CONTEXT. This is what makes the test framework recognize this class as a test context and scan it for test methods. Eventually, when Newspeak supports it, class metadata will be used instead to mark classes as test contexts.

This important point is worth reiterating. A class is a test context if and only if it contains a class-side method named TEST_CONTEXT. Inheriting from TestContext by itself does NOT make a class a test context, it only provides it with behavior such as the various #assert:... messages useful in test methods. Being a test context means that the class is scanned for test methods by the framework, and instantiated to run each of those methods.

SHARED STATE

Each test method of a test context runs within a context instance created and initialized specifically to run that method. In cases when tests need access to information which is too expensive to create for each individual test, such as a group of Newspeak modules or a database session, it is possible to share the information between the tests. To do that, we introduce a _shared state class_ between the module and the test context, as in the following nesting diagram:

	CompilerTests (top level)
	  CompilerHolder (holds onto a compiler instance; not marked a test context)
	    StatementsTests (a test context)

In this example, StatementsTests is a test context class with a number of test methods, all of which require a compiler instance to test. Assuming that creating a compiler is expensive, we instead nest the test context in a class called CompilerHolder, defined something like

	class CompilerHolder = (
	| compiler = Compiler configuredInAParticularWay.
	...

We assume that 'Compiler' is a name appropriately bound by the CompilerTests module. The CompilerHolder class is not marked as a test context, and does not require any particular behavior other than supporting the #new factory message.

The CompilerHolder class is instantiated only once before running all the tests of the CompilerTests module. The StatementsTests class of the CompilerHolder instance is repeatedly instantiated for each test it defines. Each instance of StatementsTests sees the 'compiler' slot of its enclosing object, which allows all of the tests defined in StatementsTests to use the same compiler instance.

More precisely, the behavior in the general case is this. To detect and run tests, the test framework recursively traverses class declarations starting from that of the top-level module and stopping at classes marked as test contexts. Classes nested inside a test context, if any, are ignored. In the resulting tree, the framework considers three distinct parts. The root of the tree is the class of the top-level test module instance (which already exists). The leaves of the tree are test context classes. Any nodes between the root and the leaves are shared state classes. Instances of shared state classes are created once before running the entire batch of tests defined in all test contexts of the module. Instances of test contexts are created multiple times, once for each test method of a context.

RUNNING IT: TEST CONFIGURATIONS

Like any Newspeak module, a test module expects the platform and other necessary information to be provided at the time an instance is created. That information includes the factory such as a class object, that will create the actual instances to test. At different times it may make sense to instantiate a module with different sets of parameters, for example to test different versions of a class or different classes implementing the same interface. Any such specific configuration of a test module is captured as a _test configuration_ class.

A test configuration is defined as a top-level class, similar to an application configuration. The test configuration class always has #packageTestsUsing: as its factory method.  Like an application configuration, a test configuration is supplied with a manifest that provides access to all top-level modules it will need. Also like an application configuration, a test configuration is expected to capture in its private slots ('import') references to any modules it will eventually instantiate. For example, a configuration for the ListTesting module above may look something like

	class ListTestingConfiguration using: manifest = (
	|
	private ListTesting = manifest ListTesting.
	private LinkedList = manifest Collections LinkedList.
	|
	...

A configuration class should implement one instance-side method named testModulesUsingPlatform:minitest:. The method should instantiate and return a collection of configured test modules (in our example, only one).

	public testModulesUsingPlatform: platform minitest: minitest = (
	^{ListTesting usingPlatform: platform minitest: minitest listClass: LinkedList}

If the Collections module includes other implementors of the List interface, the example can be extended to use multiple instances of ListTesting to test other implementors. For example, provided there is a collection class named ArrayList in Collections and it has been 'imported' into a slot of ListTestingConfiguration, we could rewrite the method to test both implementations:

	testModulesUsingPlatform: platform minitest: minitest = (
	^{
	  ListTesting usingPlatform: platform minitest: minitest listClass: LinkedList.
	  ListTesting usingPlatform: platform minitest: minitest listClass: ArrayList.
	}

Alternatively, we may define a separate test configuration to test ArrayList.

REEDUCATION FOR SUNIT USERS

The following is a comparison of the key differences between the traditional SUnit API and the goodthinkful way of doing the same thing.

TestCase vs TestContext

In SUnit, tests are defined as methods of a subclass of TestCase, while in Minitest TestContext takes it place. This is not a simple renaming. SUnit's TestCase suffers from a split personality. It is both a test fixture, which is a particular configuration of tested object on which a set of tests can be performed, and a command to run one of those tests. It is also another thing that we will eventually get to. The author believes this confusion, repeated in SUnit clones for other languages, leads to increased complexity and inconsistencies in terms and concepts (for example, by defining 'a TestCase' in SUnit, we in fact define many test cases). In contrast, Minitest assigns these responsibilities to separate classes, which are TestContext and TestCase. A test context defines a configuration of tested objects and the actual tests, while a TestCase is a command object for running a particular test of a test context. Minitests's TestCase is internal to the framework implementation and not normally exposed to the framework users.

The role of TestCase/TestContext as a superclass

Because of the merging of two independent concepts in SUnit's TestCase, the TestCase class in SUnit must be a superclass of a user-defined set of tests. In Minitest, a test context is recognized as a class marked as such (currently with a marker method, eventually in the class's metadata). A test context class usually inherits from TestContext, however that is not required by the framework. The only reason for this inheritance is to allow the use in test methods of the various #assert: methods defined by TestContext. A test context class is free not to inherit from TestContext, as long as it has some other way to signal the TestFailureException in case of a test failure. (This is why this text usually refers to a Minitest test context as 'a test context' rather than 'a TestContext').

The #setUp method vs instance initializer

In SUnit, any necessary initialization of a TestCase subclass is performed by the #setUp method. In Minitest, instances of text contexts are initialized (naturally) by their initializers. Again, the reason for this difference is the split personality of SUnit's TestCase, leading to what in essense are multiple initialization schemes for those personalities.

The #tearDown method vs the #cleanUp method

A test context (or a shared class instance) can define any necessary clean up behavior as a method named #cleanUp. A similar method in SUnit is named #tearDown. Minitest makes this API change because of the necessary change to the other half of lifecycle management (#setUp vs instance initializer), and also because the author believes cleanUp is a more natural name, which is now free of danger of being confused with setUp.

TestResources vs shared state classes

SUnit provides test resources as a mechanism to share expensive to create objects between a batch of test cases. Minitest does that using enclosing shared state classes. There is no dedicated TestResource class in Minitest because the framework expects nothing from the shared state class API other than the ability to create an instance using #new. At the same time, the framework takes care of creating and cleaning up their instances, so the test programmer is free from concerns of maintaining resource instances and managing their lifecycle. Shared state is naturally accessible to all tests that require it a part of the lexical scope. Lexical containment also naturally specifies which tests require which resources, without the fragility and obscurity of the various #resources methods of SUnit.

TestCases vs test configurations

A TestCase subclass in SUnit is a concrete runnable test artifact (in the sense that we can select one in a UI tool and run its tests). In Minitest, a test module with any tests it contains is only an abstract declaration. It needs a test configuration to instantiate it with a specific set of parameters. Test configuration is the third personality of SUnit's TestCase separated into an independent class in Minitest. More about this in the next section.

TestCase subclassing vs parameterizable tests

SUnit supports further subclassing of TestCase subclasses. For example, tests for a widget library can define, say, WidgetTestCase with LabelTestCase and ButtonTestCase as subclasses. WidgetTestCase is an abstract class defining tests of the API common to all widgets, while ButtonTestCase specializes it with tests specific to buttons. It also defines the concrete class tests inherited from WidgetTestCase apply to. Running ButtonTestCase is supposed to run both the tests defined locally as well as those inherited from WidgetTestCase.

Minitest does not--and more importantly, does not need to--support test context inheritance to accomplish what is described above. More precisely, any class in a test module is free to inherit from any other class, be it a test context or not. However, if a test context class inherits from another test context class, only test methods defined locally in that particular class are recognized and executed by the framework. This is not a limitation, but rather the test parameterization story made straight. Let's begin with an example of the Minitest way of organizing the tests described above.

We define 3 test modules with the following factory signatures:

	WidgetTesting usingPlatform: platform minitest: minitest widgetClass: aClass
	LabelTesting usingPlatform: platform minitest: minitest labelClass: aClass
	ButtonTesting usingPlatform: platform minitest: minitest buttonClass: aClass

Each would have at least one test context class with all the appropriate tests. We also define two configuration classes, LabelTestConfiguration and ButtonTestConfiguration. As an example, LabelTestConfiguration would import the Label class from the widget library and define this method:

	testModulesUsingPlatform: platform minitest: minitest = (
	^{
	  WidgetTesting usingPlatform: platform minitest: minitest widgetClass: Label.
	  LabelTesting usingPlatform: platform minitest: minitest labelClass: Label.
	}

Here is why this approach is cleaner. Remember the point from the discussion of TestCases and test configurations above. The third overloaded responsibility of TestCase in SUnit is test configuration. A LabelTestCase needs to inherit from WidgetTestCase so that the tests of the Widget interface defined in that abstract class can be applied to a concrete implementation (Label). The Minitest example uses the fact test definition is parameterizable by test configuration to organize the code around this pattern:

1. A module does not hardcode the actual implementation class it tests, instead expecting a _factory_ (in this case a class metaobject) that can manufacture instances to test on request.

2. All tests in a module are written to test a particular _interface_. Different interfaces should be tested by different modules.

3. A test configuration is what chooses a particular _implementation class_ to test. The configuration creates test modules for all interfaces the class implements, parameterized with the class being tested.

This pattern is the recommended way to organize tests using Minitest. You can see that the ListTesting and ListTestingConfiguration follow a similar idea. ListTesting defines tests of the List interface, while the configuration applies it to two concrete implementation classes.


LICENSE

Copyright (c) 2010 Vassili Bykov
Copyright (c) 2012 Cadence Design Systems, Inc.

Licensed under the MIT license:

Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the ''Software''), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:

The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE. *)
|
	private Exception = platform kernel Exception.
	private UnhandledError = platform kernel UnhandledError.

	private Map = platform collections Map.
	private IdentityMap = platform collections IdentityMap.
	private IdentitySet = platform collections IdentitySet.
	private List = platform collections List.
	private Set = platform collections Set.

	private Promise = platform actors Promise.

	private ObjectMirror = platform mirrors ObjectMirror.
	private Message = platform kernel Message.
|) (
class TestCase environment: testEnvironment <TestEnvironment> selector: s <Symbol> = (
(* Represents a particular test (a method with the selector that begins with 'test') in a text context. This class, unlike SUnit's class by the same name, is internal to the framework and is not intended to be subclassed or instantiated by framework users. See TestContext.

An instance holds onto a test environment (which indirectly identifies the test context class) and a selector within the class. While a test is running, an instance also holds onto the test context's instance created to run the test. That instance is created prior to running the test. If the test is successful, the instance is immediately discarded. In case of a failure or an error, the instance is retained so that its state can be examined. *)
|
	public environment <TestEnvironment> = testEnvironment.
	public selector <Symbol> = s.
	testContextInstance <TestContext>
|) (
public cleanUp = (
(* Clean up and forget the test context instance. This method runs within an exception handler established by the runUsing: method, so any errors in test context instance cleanup are ok. *)
	testContextInstance isNil ifFalse:
		[testContextInstance cleanUp.
		testContextInstance:: nil]
)
instantiateTestContextUsing: tester <Tester> = (
	testContextInstance:: environment createInstanceIn: (tester instanceFor: environment parent)
)
public printOn: stream <WriteStream> = (
	super printOn: stream.
	stream nextPutAll: ' ('.
	environment printOn: stream.
	stream nextPutAll: ' '.
	selector printOn: stream.
	stream nextPutAll: ')'.
)
public runToDebugFailureUsing: tester <Tester> ^<TestResult> = (
	instantiateTestContextUsing: tester.
	[sendTestMessage]
		ensure: [cleanUp]
)
public runUsing: tester <Tester> ^<TestResult> = (
	^[self runUnsafeUsing: tester]
		on: Error
		do: [:ex | ^nil = testContextInstance
					ifTrue: [TestError case: self exception: ex]
					ifFalse: [testContextInstance createErrorResultFor: self exception: ex]]
)
sendTestMessage = (
	^(Message selector: selector arguments: {})
		sendTo: testContextInstance
)
public isKindOfTestCase ^ <Boolean> = (
  ^true
)
public runUnsafeUsing: tester <Tester> ^<TestResult> = (
	| testSuccess |
	instantiateTestContextUsing: tester.
	[sendTestMessage.
	(* At this point the test has been successful, so create the TestSuccess before it is removed. *)
	testSuccess:: testContextInstance createSuccessResultFor: self.
	(* Clean up immediately after a successful test. This makes the test context instance
	immediately garbage-collectable, which is an important property for large test suites. *)
	cleanUp]
		on: TestFailureException
		do: [:ex | ^nil = testContextInstance (* testContextInstance should never be nil at this point, but just in case. *)
					ifTrue: [TestFailure case: self description: ex messageText]
					ifFalse: [testContextInstance createFailureResultFor: self description: ex messageText]].
	^testSuccess
)
public runAsyncUsing: tester <Tester> ^<Promise[TestResult]> =  (
	instantiateTestContextUsing: tester.
	^Promise
		when: [self sendTestMessage] <-: value
		fulfilled:
			[:resolution |
			(* At this point the test has been successful, so create the TestSuccess before it is removed. *)
			| testSuccess = testContextInstance createSuccessResultFor: self. |
			(* Clean up immediately after a successful test. This makes the test context instance
	immediately garbage-collectable, which is an important property for large test suites. *)
			cleanUp.
			testSuccess]
		broken:
			[:problem |
            problem isKindOfTestFailureException ifTrue: [
               nil = testContextInstance 
                 ifTrue: [TestFailure case: self description: problem messageText]
				 ifFalse: [testContextInstance createFailureResultFor: self description: problem messageText].
            ] ifFalse: [
            nil = testContextInstance
				ifTrue: [TestError case: self exception: problem]
				ifFalse: [testContextInstance createErrorResultFor: self exception: problem]]]
)
) : (
)
public class TestCatalog forModule: testModule = (
(* A catalog of test suites defined by a given test module instance. A catalog is created using the primary forModule: factory method. Each of test context classes of the module produces a TestSuite that lists all test methods in the class. The catalog can report the names of all test context classes, and return a TestSuite corresponding to each class. It can also return a TestSuite with the union of all the class-level TestSuites. *)
|
	testModule <Object> = testModule.
	testsByContextName <Map[String, TestSuite]> = Map new.
|Initializer new populate) (
class Initializer = (
(* An initializer populates the enclosing catalog with content extracted from the test module. This class is internal to the TestCatalog implementation. *)
) (
examineClass: mirror <ClassDeclarationMirror> under: parentEnvironment <TestEnvironment> = (
(* Examine the given class. If it is a test context, create a test suite listing its test cases and add it to the catalog. *)
	| thisEnvironment |
	thisEnvironment:: TestEnvironment parent: parentEnvironment classDeclarationMirror: mirror.
	(isTestContext: mirror) ifTrue:
		[thisEnvironment testCases: (testCasesIn: mirror environment: thisEnvironment).
		parentEnvironment addNestedEnvironment: thisEnvironment.
		(* Nested test contexts do not appear to be useful, so once a test context is found
		we do not look inside it. The framework's own tests rely on this. *)
		^self].
	mirror instanceSide nestedClasses do:
		[:each |
		examineClass: each under: thisEnvironment].
	(* If after all the examination thisEnvironment ends up with no test cases, or child
	environments containing test cases, its class need not to be instantiated at runtime.
	In that case we can forget it right here - no need to add it to the parent. *)
	thisEnvironment hasTestCasesTransitively ifTrue:
		[parentEnvironment addNestedEnvironment: thisEnvironment]
)
isTestContext: mirror <ClassDeclarationMirror> = (
	^mirror classSide methods includesMirrorNamed: testContextMarkerSelector
)
isTestMethod: methodMirror <MethodMirror> = (
	| selector |
	selector:: methodMirror name.
	^(selector startsWith: 'test') and: [(selector endsWith: ':') not]
)
public populate = (
(* Populate the testsByContextName dictionary of the enclosing TestCatalog instance with information extracted from the module. *)
	| moduleMirror moduleEnvironment |
	moduleEnvironment:: TopLevelTestEnvironment module: testModule.
	moduleMirror:: (ObjectMirror reflecting: testModule) getClass.
	moduleMirror nestedClasses do:
		[:each | examineClass: each under: moduleEnvironment].
	moduleEnvironment withAllNestedEnvironmentsDo:
		[:each |
		each hasTestCases ifTrue:
			[testsByContextName at: each name put: each testSuite]]
)
testCasesIn: classMirror <ClassDeclarationMirror> environment: environment <TestEnvironment> ^<Collection[TestCase]> = (
(* Return a collection of TestCases describing test methods in the given class. *)
	| testCases |
	testCases:: List new.
	classMirror instanceSide methods do:
		[:each <MethodMirror> |
		(isTestMethod: each) ifTrue:
			[testCases add:
				(TestCase environment: environment selector: each name)]].
	^testCases
)
testContextMarkerSelector = (
(* A class that has a class-side method with this selector is recognized by the Initializer as a test context class. (The class's superclass chain is unimportant--test contexts inherit from TestContext only in order to get testing behavior such as the #assert: method). *)
	^#TEST_CONTEXT
)
) : (
)
public allTests ^<TestSuite> = (
(* Returns a test suite containing all test cases defined in all test context classes of the catalogued module. *)
	| allTestCases |
	allTestCases:: List new: testsByContextName size + 1 * 20.
	testsByContextName do: [:each | allTestCases addAll: each testCases].
	^TestSuite testCases: allTestCases
)
public testSuiteNamed: key <String> = (
(* Returns a test suite containing all test cases of the given class. *)
	^testsByContextName at: key
)
public testSuiteNames ^<Collection[String]> = (
	(* Returns the (short) names of test context classes of the module. *)
	^testsByContextName keys
)
) : (
)
public class TestContext = (
(* An object for defining and running individual tests. In this respect, it is the same thing as the TestCase class of the traditional SUnit framework. Unlike SUnit's TestCase, an instance does not double as a command for running a particular test method.

This class provides the behavior useful for running tests, such as the various #assert: methods inheritable by the user's TestContext subclasses. Inheriting that behavior is the only real reason to inherit from TestContext. The test framework does NOT recognize the user's test contexts on the basis of their inheritance. Instead, each class to be treated as a test context should be marked as such. Currently, it is done with a class-side marker method named TEST_CONTEXT. In the future, marker methods will be superseded by proper class metadata.

An instance is initialized by its 'natural' initializer. If any special cleanup behavior is required after running a test, a subclass may reimplement the #cleanUp method to define it. *)
) (
assert: aBlockOrValue <[Boolean] | Boolean> = (
	assert: aBlockOrValue description: 'Assertion failed'
)
assert: aBlockOrValue <[Boolean] | Boolean> description: messageText <String> = (
	assert: aBlockOrValue descriptionBlock: [messageText]
)
assert: aBlockOrValue <[Boolean] | Boolean> descriptionBlock: messageBlock <[String]> = (
	aBlockOrValue isKindOfClosure
		ifTrue: [aBlockOrValue value ifFalse: [failWithMessage: messageBlock value]]
		ifFalse: [aBlockOrValue ifFalse: [failWithMessage: messageBlock value]].
)
assert: anObject equals: expectedObject = (
	(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
	assert: anObject = expectedObject descriptionBlock:
		['Equality assertion failed; expected: ',
		 expectedObject printString,
		 ', was: ',
		 anObject printString]
)
assert: anObject equals: anotherObject description: messageText = (
	(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
	assert: anObject = anotherObject description: messageText
)
assert: anObject equals: anotherObject descriptionBlock: messageBlock = (
	(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
	assert: anObject = anotherObject descriptionBlock: messageBlock
)
assertList: actualList equals: expectedList = (
	assert: actualList size = expectedList size descriptionBlock:
		['List equality assertion failed; expected: ',
		 expectedList printString,
		 ', was: ',
		 actualList printString].
	1 to: actualList size do:
		[:index | assert: (actualList at: index) equals: (expectedList at: index)].
)
public cleanUp = (
(* Sent after a successful completion of a test, to clean up if simple garbage collection at some point in the future is not enough (which it normally should be). If a test completes abnormally, with either a failure or an error, the test context is retained by the test case which in turn is retained by the test result. In this case, the message is not sent until a later time when the test results are discarded. *)
)
public createErrorResultFor: testCase <TestCase> exception: ex <Error> = (
	^TestError case: testCase exception: ex
)
public createSuccessResultFor: testCase <TestCase> = (
	^TestSuccess case: testCase
)
deny: aBlockOrBoolean <[Boolean] | Boolean> = (
	deny: aBlockOrBoolean description: 'Denial failed'
)
deny: aBlockOrBoolean <[Boolean] | Boolean> description: messageText <String> = (
	deny: aBlockOrBoolean descriptionBlock: [messageText]
)
deny: aBlockOrBoolean <[Boolean] | Boolean> descriptionBlock: messageBlock <[String]> = (
	aBlockOrBoolean isKindOfClosure
		ifTrue: [aBlockOrBoolean value ifTrue: [failWithMessage: messageBlock value]]
		ifFalse: [aBlockOrBoolean ifTrue: [failWithMessage: messageBlock value]].
)
deny: anObject equals: expectedObject = (
	(* Succeed if (anObject = anotherObject) not. Preferrable to a simple 'deny: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
	deny: anObject = expectedObject descriptionBlock:
		['Inequality assertion failed; expected not: ',
		expectedObject printString,
		', was: ',
		anObject printString]
)
failWithMessage: messageText <String | nil> = (
	TestFailureException new signal: messageText
)
should: aBlock signal: anException = (
	should: aBlock signal: anException description: 'Expected exception not signalled'
)
should: aBlock signal: anException <Class | ExceptionSet> description: failureMessage <String> = (
	should: aBlock signal: anException descriptionBlock: [failureMessage]
)
should: aBlock signal: anException <Class | ExceptionSet> descriptionBlock: descriptionBlock <[String]> = (
	| signalled ::= false. |
	[aBlock value]
		on: anException
		do: [:ex | signalled:: true].

	signalled ifFalse: [failWithMessage: descriptionBlock value].
)
shouldnt: aBlock signal: anException = (
	shouldnt: aBlock signal: anException description: 'Exception signalled'
)
shouldnt: aBlock signal: anException <Class | ExceptionSet> description: failureMessage <String> = (
	shouldnt: aBlock signal: anException descriptionBlock: [failureMessage]
)
shouldnt: aBlock signal: anException <Class | ExceptionSet> descriptionBlock: descriptionBlock <[String]> = (
	[aBlock value]
		on: anException
		do: [:ex | failWithMessage: descriptionBlock value]
)
public createFailureResultFor: testCase <TestCase> description: description <String> ^ <TestFailure> = (
	^TestFailure case: testCase description: description
)
) : (
)
class TestEnvironment parent: parent classDeclarationMirror: mirror = (
(* Describes a class nested inside a test module. The class can be either a test context or a parent (direct or indirect) of at least one test context. Environments form a tree, with those that represent test contexts being the leaves. Environment are used by the framework to orchestrate the instantiation of their classes when running tests.

An instance holds onto the parent and a collection of child environments. The class accessor name is the selector of a message that can be sent to a class metaobject corresponding to the parent environment to obtain a class metaobject corresponding to this environment. For an environment representing a test context, testCases holds a collection (not a real TestSuite) of TestCases defined in the test context. *)
|
	public parent <TestEnvironment | TopLevelTestEnvironment> = parent.
	nestedEnvironments <Collection[TestEnvironment]> = List new.
	public testCases <Collection[TestCase]> ::= List new.
	public classDeclarationMirror <ClassDeclarationMirror> = mirror.
|) (
public addNestedEnvironment: environment = (
	nestedEnvironments add: environment
)
classAccessorName = (
(* The class accessor name is the selector of a message that can be sent to a class metaobject corresponding to the parent environment to obtain a class metaobject corresponding to this environment. *)
	^classDeclarationMirror simpleName
)
classIn: parentObject <Object> ^<Class> = (
(* Returns a class metaobject represented by this environment specific for the given instance of the class corresponding to this environment's parent. *)

	^(Message selector: classAccessorName arguments: {})
		sendTo: parentObject
)
public createInstanceIn: parentObject <Object> ^<Object> = (
(* Creates and returns an instance of the class represented by this environment. *)
	^(classIn: parentObject) new
)
public hasTestCases ^<Boolean> = (
(* True if the class represented by this environment defines any test methods. *)
	^testCases isEmpty not
)
public hasTestCasesTransitively ^<Boolean> = (
	(* True if either the class represented by this environment or any of its nested classes define any test methods. *)
	hasTestCases ifTrue: [^true].
	nestedEnvironments do: [:any | any hasTestCasesTransitively ifTrue: [^true]].
	^false
)
public isRoot ^<Boolean> = (
(* True if this is a top-level environment representing the entire test module. *)
	^false
)
public name = (
	^classAccessorName
)
public parentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with direct and indirect parents of this environment, starting with the direct one and proceeding up to the top level. *)
	parent withAllParentEnvironmentsDo: aBlock
)
public printOn: stream <WriteStream> = (
	super printOn: stream.
	stream nextPutAll: ' '.
	classAccessorName printOn: stream.
)
public testSuite = (
	^TestSuite testCases: testCases
)
public withAllNestedEnvironmentsDo: aBlock = (
(* Evaluate aBlock with the receiver and all members of the transitive closure of its nested environments, in preorder. *)
	aBlock value: self.
	nestedEnvironments do: [:each | each withAllNestedEnvironmentsDo: aBlock]
)
public withAllParentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with the receiver and all environment in its parent chain all the way up to the top level, beginning with the receiver. *)
	aBlock value: self.
	parent withAllParentEnvironmentsDo: aBlock
)
) : (
)
public class TestError case: testCase exception: exception = TestResult case: testCase (
(* Represents a test case that didn't complete because an error was signaled and not handled while running the test case. The instance holds onto the exception instance representing the error. *)
|
	public exception ::= exception.
|) (
public isError = (
	^true
)
public isKindOfTestError ^ <Boolean> = (
  ^true
)
) : (
)
public class TestFailure case: testCase description: text <String> = TestResult case: testCase (
(* Represents a failed assertion in a test case. *)
|
	public description ::= text.
|) (
public isFailure = (
	^true
)
public isKindOfTestFailure ^ <Boolean> = (
  ^true
)
) : (
)
class TestFailureException = Exception (
(* An exception thrown when an assertion fails inside a test. The description of the failure is the exception's message text. *)
) (
public defaultAction = (
	UnhandledError signalForException: self
)
public isKindOfTestFailureException ^ <Boolean> = (
  ^true
)
) : (
)
class TestResult case: testCase = (
(* The result of running a TestCase. An abstract class. *)
|
	public testCase ::= testCase.
|) (
public cleanUp = (
	testCase cleanUp
)
public isError ^<Boolean> = (
	^false
)
public isFailure ^<Boolean> = (
	^false
)
public isSuccess ^<Boolean> = (
	^false
)
public isKindOfTestResult ^ <Boolean> = (
  ^true
)
) : (
)
public class TestSuccess case: testCase = TestResult case: testCase (
(* Represents a successful run of a test case. *)
) (
public isSuccess = (
	^true
)
public isKindOfTestSuccess ^ <Boolean> = (
  ^true
)
) : (
)
public class TestSuite testCases: testCases <Collection[TestCase]> = (
(* A TestSuite is a collection of TestCases. TestSuites are usually obtained from a TestCatalog created on an instance of a test module. *)
|
	private testCases_slot <Collection[TestCase]> = testCases.
|) (
+ another <TestSuite> ^<TestSuite> = (
	(* Returns a new TestSuite that contains TestCases of the receiver and the argument. *)
	^TestSuite testCases: testCases, another testCases
)
public ++ another <TestSuite> ^<TestSuite> = (
	(* Returns a new TestSuite that contains TestCases of the receiver and the argument. *)
	^TestSuite testCases: testCases, another testCases
)
modules ^<Collection[Object]> = (
(* Returns a collection of test module instances that contain test cases of the suite. *)
	| result |
	result:: IdentitySet new.
	testCases do: [:each | result add: each module].
	^result
)
public size ^<Integer> = (
(* Returns the number of test cases in the suite. *)
	^testCases size
)
public testCases ^<Collection[TestCase]> = (
(* Returns a collection of test cases of the receiver. *)
	^testCases_slot
)
) : (
)
public class Tester testSuite: suite <TestSuite> = (
(* A tool for executing TestCases. TestCases are supplied to it in the form of a TestSuite. An instance is single-use only. First it is created using the testSuite: primary factory method. Then the tests are executed, either by sending the #runAll message, or by reproducing the steps defined by #runAll in an external tool. Finally, the results can be retrieved from the 'errors', 'failures' and 'successes' slots. *)
|
	public errors <List[TestError]>
	public failures <List[TestFailure]>
	public successes <List[TestSuccess]>
    public disabled <Collection[TestCase]> = List new.
    active_slot <Collection[TestCase]>    
    public inactive <Collection[TestCase]> = suite testCases copyFrom: 1 to: suite testCases size.
	private testSuite <TestSuite> = suite.
	public testCaseList
	private testsPerformed_ <Integer>
	private instanceManager <TestContextManager> = TestContextManager new.
|) (
class TestContextManager = (
(* Creates and keeps track of instances of shared state classes for a test run. Shared state classes are classes nested inside a test module that in turn contain other shared state classes and/or test context classes. In other words, they are the classes that are neither the root nor the leaves of the class nesting tree. Within this class, instances of these classes are referred to as 'core instances'. *)
|
	instancesByEnvironment ::= IdentityMap new.
|) (
public cleanUpCoreInstances = (
(* Send the #cleanUp message to all core instances able to understand that message. *)
	instancesByEnvironment do:
		[:each |
		(understandsCleanUp: each) ifTrue: [each cleanUp]].
	instancesByEnvironment:: IdentityMap new.
)
public ensureInstanceFor: environment <TestEnvironment> ^<Object> = (
(* Return an instance of the class represented by the argument, creating one if necessary. *)
	environment isRoot ifTrue: [^environment moduleInstance].
	^instancesByEnvironment at: environment ifAbsent:
		[| instance |
		instance:: environment createInstanceIn: (ensureInstanceFor: environment parent).
		instancesByEnvironment at: environment put: instance.
		instance]
)
understandsCleanUp: object = (
(* Answer true if the object understands the #cleanUp message. *)
	| mirror |
	mirror:: (ObjectMirror reflecting: object) getClass.
	^mirror methods includesMirrorNamed: #cleanUp
)
public createCoreInstancesForGroup: testCases <Collection[TestCase]> = (
(* Create instances of shared state classes required to run the argument testCase. See #createCoreInstances. *)
	(coreEnvironmentsForGroup: testCases) do:
		[:each |
		ensureInstanceFor: each]
)
public createCoreInstances = (
(* Create instances of all shared state classes, which are the classes that are not test contexts themselves but rather contain test contexts directly or indirectly. Such classes are instantiated once before running a suite of tests and cleaned up afterwards. *)
	coreEnvironments do:
		[:each <TestEnvironment> |
		ensureInstanceFor: each]
)
public createCoreInstancesFor: testCase <TestCase> = (
(* Create instances of shared state classes required to run the argument testCase. See #createCoreInstances. *)
	(coreEnvironmentsFor: testCase) do:
		[:each <TestEnvironment> |
		ensureInstanceFor: each]
)
coreEnvironments ^ <Set[TestEnvironment]> = (
(* The core of the environment tree are the environments between the roots of the class tree and its fringe. They have to be instantiated once before running the suite and cleaned up after. *)
	| result <Set[TestEnvironment]> |
	result:: Set new.
	testSuite testCases do:
		[:each |
		each environment parentEnvironmentsDo:
			[:eachParent <TestEnvironment> |
			eachParent isRoot ifFalse: [result add: eachParent]]].
	^result
)
coreEnvironmentsForGroup: testCases <Collection[TestCase]> ^ <Set[TestEnvironment]> = (
(* The core of the environment tree are the environments between the roots of the class tree and its fringe. They have to be instantiated once before running the suite and cleaned up after. *)
	| result <Set[TestEnvironment]> |
	result:: Set new.
	testCases do:
		[:each |
		each environment parentEnvironmentsDo:
			[:eachParent <TestEnvironment> |
			eachParent isRoot ifFalse: [result add: eachParent]]].
	^result
)
coreEnvironmentsFor: testCase <TestCase> ^ <List[TestEnvironment]> = (
	| result <List[TestEnvironment]> |
	result:: List new.
	testCase environment parentEnvironmentsDo:
		[:each <TestEnvironment> |
		each isRoot ifFalse: [result add: each]].
	^result
)
) : (
)
public atEnd = (
	(* Returns true if all test cases in the test suite have been executed. *)
	^testsPerformed = testCount
)
public cleanUp = (
(* This message should be sent to the tester once at some point after finishing running the tests. This will cause the tester to send the #cleanUp message to all instances of shared state classes created to run the tests. Sending this message is not essential to the test framework functionality, but without sending it the cleanup logic of shared state classes will not be called. However, an IDE tool may choose to delay sending this message in case there are tests failures or errors, so that the shared state can be examined by the user. *)
	instanceManager cleanUpCoreInstances.
)
public cleanUpResults = (
(* This message causes the #cleanUp message to be sent to all test results, which in turn clean ups their associated test cases, cleaning up and making garbage-collectable any test context instances they may still be holding onto. *)
	successes do: [:each | each cleanUp].
	errors do: [:each | each cleanUp].
	failures do: [:each | each cleanUp]
)
public completedRatio ^<Float> = (
	(* Return a number between 0 and 1 indicating the ratio of tests in the suite completed so far. *)
	^testCount = 0
		ifTrue: [1.0]
		ifFalse: [testsPerformed asFloat / testCount]
)
public haveAllTestsSucceeded = (
	^errors size = 0 and: [failures size = 0]
)
public instanceFor: environment <TestEnvironment> ^<Object> = (
	^instanceManager ensureInstanceFor: environment
)
public runAll = (
	prepare.
	[[atEnd] whileFalse: [step]]
		ensure: [cleanUp]
)
public runToDebugFailure: testCase = (
	instanceManager createCoreInstancesFor: testCase.
	[testCase runToDebugFailureUsing: self]
		ensure: [cleanUp]
)
public runWithNoExceptionHandling: testCase = (
	instanceManager createCoreInstancesFor: testCase.
	[testCase runUnsafeUsing: self]
		ensure: [cleanUp]
)
public testsPerformed ^ <Integer> = (
	^testsPerformed_
)
public isEnabled: tc ^ <Boolean> = (
  disabled detect: [:dt <testCase> | dt = tc] ifNone: [^true].
  ^false
)
disableTestCase: tc = (
  0 = (disabled indexOf: tc) 
    ifTrue: [disabled add: tc]
    ifFalse: [shouldNotHappen].
)
disableFailure: tf <TestFailure> = (
  | tc <TestCase> = tf testCase. |
  failures remove: tf ifAbsent: [].
  disableTestCase: tc.
)
disableError: te <TestError> = (
  | tc <TestCase> = te testCase. |
  errors remove: te ifAbsent: [].
  disableTestCase: tc.
)
disableSuccess: ts <TestSuccess> = (
  | tc <TestCase> = ts testCase. |
  successes remove: ts ifAbsent: [].
  disableTestCase: tc.
)
computeInactiveTests ^ <Set[TestCase]> = (
^(Set withAll: testCaseList)
      removeAll: (errors collect: [:tr <TestResult> | tr testCase]);
      removeAll: (failures collect: [:tr <TestResult> | tr testCase]);
      removeAll: (successes collect: [:tr <TestResult> | tr testCase]);
      yourself
)
public peekSelector ^<Symbol> = (
	(* Returns the selector of the upcoming test case. This message should only be sent if the #atEnd message returns false. *)
	^(active at: testsPerformed_ + 1) selector
)
public testCount ^ <Integer> = (
	^active size
)
public prepare = (
	(* This message must be sent to the tester once prior to running any tests. At this stage the tester instantiates shared state classes of the test module, which may potentially cause errors to be signaled. *)
	errors:: List new.
	failures:: List new.
	successes:: List new.
	testCaseList:: testSuite testCases.
    active_slot:: (Set withAll: testCaseList) removeAll: disabled; asArray.
	testsPerformed_:: 0.
	instanceManager createCoreInstances.
)
active ^ <Collection[TestCase]> = (
   active_slot isNil ifTrue: [
     active_slot:: (Set withAll: testCaseList) removeAll: disabled; asArray
   ].
   ^active_slot
)
public step ^<TestResult> = (
	(* Execute one test case, add the result to the appropriate collection and return it. This message should only be sent if the #atEnd message returns false. *)
	| case result |
	case:: active at: testsPerformed_ + 1.
	result:: case runUsing: self.
    inactive remove: case ifAbsent: [].
	testsPerformed_:: testsPerformed_ + 1.
	result isError ifTrue: [errors add: result].
	result isFailure ifTrue: [failures add: result].
	result isSuccess ifTrue: [successes add: result].
	^result
)
public stepAsync ^<TestResult> = (
	(* Execute one test case, add the result to the appropriate collection and return it. This message should only be sent if the #atEnd message returns false. *)
	| case |
	case:: active at: testsPerformed_ + 1.
	^Promise when: (case runAsyncUsing: self) fulfilled:
		[:result |
         inactive remove: case ifAbsent: [].
		 testsPerformed_:: testsPerformed_ + 1.
		 result isError ifTrue: [errors add: result].
		 result isFailure ifTrue: [failures add: result].
		 result isSuccess ifTrue: [successes add: result].
		 result]
)
public enable: tc <TestCase> = (
  tc isKindOfTestCase ifTrue: [
    (* only add tc to inactive if it's not already there *)
    (inactive includes: tc) ifFalse: [
      inactive add: tc.
      disabled remove: tc ifAbsent: [Error signal: 'inconsistency in TestingOutcomeSubject>>enable:'].
      ^self
      ].
  ].
)
public run: testCase = (
  | result <TestResult> |
	instanceManager createCoreInstancesFor: testCase.
	[
      removeTestCase: testCase from: errors.
      removeTestCase: testCase from: failures.
      removeTestCase: testCase from: successes.
      inactive remove: testCase ifAbsent: [].
      result:: testCase runUsing: self.
	  result isError ifTrue: [errors add: result].
	  result isFailure ifTrue: [failures add: result].
	  result isSuccess ifTrue: [successes add: result].      
    ] ensure: [cleanUp]
)
removeTestCase: tc <TestCase> from: resultList <List[TestResult]> = (
  | tr <testResult> = resultList detect: [:r <TestResult> | r testCase selector = tc selector] ifNone: []. |
  resultList remove: tr ifAbsent: [].
)
public disable: tc <TestCase | TestResult> = (
  tc isKindOfTestFailure ifTrue: [^disableFailure: tc].
  tc isKindOfTestError ifTrue: [^disableError: tc].
  tc isKindOfTestCase ifTrue: [
    (* only add tc to disabled if it's not already there *)
    0 = (disabled indexOf: tc) ifTrue: [
      disabled add: tc.
      removeTestCase: tc from: errors.
      removeTestCase: tc from: failures.
      removeTestCase: tc from: successes.   
      inactive remove: tc ifAbsent: [Error signal: 'inconsistency in TestingOutcomeSubject>>disable:'].
      ^self
      ].
  ].
  (* tc is a success; least likely to be disabled *)
  disableSuccess: tc
)
) : (
testCatalogs: catalogs <Collection[TestCatalog]> = (
	| suite ::= TestSuite testCases: List new. |
	catalogs do: [:each | suite:: suite ++ each allTests].
	^self testSuite: suite
)
public testModules: modules <Collection[TestModule]> = (
	^testCatalogs: (modules collect: [:each | TestCatalog forModule: each])
)
)
class TopLevelTestEnvironment module: moduleInstance = (
(* A test environment representing a test module instance. Unlike regular TestEnvironments, it has no parents, but otherwise supports much of the same protocol. *)
|
	public moduleInstance = moduleInstance.
	nestedEnvironments = List new.
|) (
public addNestedEnvironment: environment = (
	nestedEnvironments add: environment
)
public hasTestCases ^<Boolean> = (
(* A top-level test module instance cannot function as a test context because it cannot be created and discarded for each test run. *)
	^false
)
public isRoot = (
	^true
)
public parentEnvironmentsDo: aBlock = (
(* No-op since this is the top level. *)
)
public withAllNestedEnvironmentsDo: aBlock = (
(* Evaluate aBlock with the receiver and all elements of the transitive closure of its nested environments (preorder). *)
	aBlock value: self.
	nestedEnvironments do: [:each | each withAllNestedEnvironmentsDo: aBlock]
)
public withAllParentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with the receiver and all environment in its parent chain, which is to say with the receiver only. *)
	aBlock value: self
)
) : (
)
) : (
)