InImageNSCompilerTestingStrategy.ns

Newspeak3
'Root'
class InImageNSCompilerTestingStrategy platform: platform mirrors: mirrors = (
(* An implementation of a compiler testing strategy that performs the tests by compiling them in the current image.

A compiler testing strategy is an interface not currently captured as an independent artifact in the system. An instance of a strategy understands the message #test:with:ifFailure:ifError:, which accepts the source of two top-level Newspeak classes. The first class is the sample to be tested, the second is the test to be run on the sample. The strategy abstracts out the specific steps necessary to compile both classes in some target environment and invoke the tests. In the simplest case, captured by this class, the classes are compiled in the same image. Alternatively, they could be compiled and executed in a different object space as a script passed to a VM invoked from the command line, or to a server process. The method may invoke one of the two blocks passed as the third and the fourth argument, the failure block and the error block. The error block is invoked if the test did not run or did not complete for reasons such as a compilation error or an unhandled exception occurred while running the test. The failure block is invoked if the test completed without errors, but at least one of the test conditions did not hold. The blocks are invoked with a String containing the error message. If neither of the blocks is invoked, the test has succeeded.

The only requirement the framework places on the test sample class is that it should be named Sample. The framework is not concerned about other implementation details such as the factory, the slots, and the interface.

The requirements it places on the test class are:

	* it should be named SampleTest
	* its primary factory should be named #test:
	* it should have an instance method named #test that performs the actual test.

For example:

class Sample = ( | slot1 slot2 | ) (
	runCascadeForEffect = (self slot1: 23; slot2: 42)
	runCascadeForValue = (^self slot1; slot2)
)

class SampleTest test: sampleClass = ( | sample = sampleClass new | ) (
	test = (
		sample runCascadeForEffect.
		assert: [sample slot1 = 23].
		assert: [sample slot2 = 42].
		assert: [sample runCascadeForValue = 42].
	)
)

In the target environment the source of the classes is combined into a module, which also provides a number of assertion methods available to the #test method. The framework effectively evaluates the expression '(SampleTest test: Sample) test' to instantiate and invoke the test. The test instantiates the sample and performs the necessary tests.

The assertion methods available in the body of the #test method are:

	assert: testBlock <[^Boolean]>
	assert: testBlock <[^Boolean]> description: descriptionText <String>
	assert: testBlock <[^Boolean]> descriptionBlock: descriptionBlock <[^String]>


Copyright 2011 Vassili Bykov

Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0 *)
|
	private platform = platform.
	private StringBuilder = platform kernel StringBuilder.
	private ClassDeclarationBuilder = mirrors ClassDeclarationBuilder.
|) (
assertionFailedClassSource ^<String> = (
	^'class AssertionFailed = Error () ()'
)
compileClassSource: src <String> ^<Class> = (
	(* Compile and install a top-level class and return the class object. *)
	^(ClassDeclarationBuilder fromUnitSource: src) install applyToObject reflectee
)
runMethodSource ^<String> = (
	^'public runIfFailure: failureBlock ifError: errorBlock = (
	[[(SampleTest test: Sample) test]
		on: AssertionFailed
		do: [:ex | ^failureBlock value: ex messageText]]
		on: Error
		do: [:ex | ^errorBlock value: ex messageText]
	)'
)
sourceOfModuleWithSample: sampleClassSource <String> test: testerClassSource <String> ^<String> = (
	| sb |
	sb:: StringBuilder new.
	sb
		writeln: 'Newsqueak2';
		writeln: '''InImageNSCompilerTesting-tmp''';
		writeln: 'class TestModule platform: platform = ( |
			private platform = platform.
			private MessageNotUnderstood = platform kernel MessageNotUnderstood.
	 		| ) (';
		writeln: assertionFailedClassSource;
		writeln: sampleClassSource;
		writeln: testerClassSource;
		writeln: assertionMethodsSource;
		writeln: runMethodSource;
		writeln: ')'.
	^sb asString
)
public test: sampleClassSource <String> with: testClassSource <String> ifFailure: failureBlock <[:String]> ifError: errorBlock <[:String]> = (
	| klass |
	klass:: compileClassSource: (sourceOfModuleWithSample: sampleClassSource test: testClassSource).
	(klass platform: platform) runIfFailure: failureBlock ifError: errorBlock
)
assertionMethodsSource ^<String> = (
	^'assert: aBlockOrValue = (
		aBlockOrValue isKindOfClosure
			ifTrue: [aBlockOrValue value ifFalse: [AssertionFailed new signal: ''Assertion failed'']]
			ifFalse: [aBlockOrValue ifFalse: [AssertionFailed new signal: ''Assertion failed'']]
	)
	assert: aBlockOrValue description: descriptionText = (
		aBlockOrValue isKindOfClosure
			ifTrue: [aBlockOrValue value ifFalse: [AssertionFailed new signal: ''Assertion failed: '', descriptionText]]
			ifFalse: [aBlockOrValue ifFalse: [AssertionFailed new signal: ''Assertion failed: '', descriptionText]]
	)
	assert: aBlockOrValue descriptionBlock: descriptionBlock = (
		aBlockOrValue isKindOfClosure
			ifTrue: [aBlockOrValue value ifFalse: [AssertionFailed new signal: descriptionBlock value]]
			ifFalse: [aBlockOrValue ifFalse: [AssertionFailed new signal: descriptionBlock value]]
	)
	assert: anObject equals: expectedObject = (
		assert: anObject = expectedObject descriptionBlock:
			[''Equality assertion failed; expected: '',
			expectedObject printString,
			'', was: '',
			anObject printString]
	)
	assertList: anObject equals: expectedObject = (
		assert: anObject size equals: expectedObject size.
		1 to: expectedObject size do:
			[:index | assert: (anObject at: index) equals: (expectedObject at: index)].
	)
	assert: aBlock signals: errorClass = (
		assert: aBlock signals: errorClass description: ''Exception expected but not signaled''
	)
	assert: aBlock signals: errorClass description: descriptionText = (
		aBlock on: errorClass do: [:ex | ^self].
		AssertionFailed new signal: descriptionText
	)'
)
) : (
)