AtomicInstallTesting.ns

Newspeak3
'Mirrors'
class AtomicInstallTesting usingPlatform: platform
	testing: installer
	compiler: c
	mirrors: ms
	testFramework: minitest = (|

	private TestContext = minitest TestContext.
	private mirrors = ms.
	private ClassDeclarationMirror = ms ClassDeclarationMirror.
	private ClassDeclarationBuilder = ms ClassDeclarationBuilder.
	private ClassMirror = ms ClassMirror.
	private ObjectMirror = ms ObjectMirror.

	private Map = platform collections Map.
	private MessageNotUnderstood = platform squeak MessageNotUnderstood.

	(* module variables *)
	private atomicInstaller = installer.
	private newCompiler = c.
	|) (
public class AtomicInstallTests = TestContext (
(* Tests of atomic installer. *)
) (
assert: instance isInstanceOf: expectedClass = (
	| actualClass = (ObjectMirror reflecting: instance) getClass reflectee. |
	assert: actualClass equals: expectedClass.
)
assert: instance isOnlyInstanceOf: klass = (
	| found ::= false. |
	klass allInstancesDo:
		[:each | each == instance
			ifTrue: [assert: found equals: false. found:: true]
			ifFalse: [failWithMessage: 'Found unexpected instance of ', klass printString, ': ', each printString]].
	found ifFalse:
		[failWithMessage: 'Expected ', instance printString, ' to be found by allInstancesDo: of ', klass printString].
)
compileToMixinRep: source <String> ^<MixinRep> = (
	^newCompiler compileClassSource: ('Newspeak3 ''NS2-tests'' ', source) within: nil
)
makeClass: source <String> ^<Class> = (
	^(makeMixin: source) |> Object.
)
makeMixin: source <String> ^<Mixin> = (
	| mixin <Mixin> rep <MxinRep> |
	rep:: compileToMixinRep: source.
	^(atomicInstaller install: {rep} withExistingMixins: Map new) first.
)
public testAddMethod = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class TestAddMethod = ()( public bar = (^35) )'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	should: [instance foo] signal: MessageNotUnderstood.

	builder instanceSide methods addFromSource: 'public foo = ( ^self bar + 7)'.
	builder install.

	assert: instance foo equals: 42.
)
public testAddNestedClass = (
	| testClass <Class> mirror <LowLevelMixinMirror> method <LowLevelMethodMirror> instance <TestAddMethod_oneClass> rep <MixinRep> nestedMixin <Class> outerMixin <Class> |
	testClass:: makeClass: 'class TestAddNestedClass = ()( public bar = (^35) )'.
	outerMixin:: (ClassMirror reflecting: testClass) mixin reflectee.
	instance:: testClass new.
	updateMixin: outerMixin withNewDefinition:
'class TestAddNestedClass = ()(
	public class Nested = () (
		public bar = (^35)
	)
)'.
	assert: instance Nested new bar equals: 35.
)
public testAddShadowedSlotSubclass = (
	| builder Module y |
	builder:: ClassDeclarationBuilder fromSource:
	'class Module = ()(
		public class X = (|
			public a = 1.
			public b = 2.
			public c = 3.
		|) ()
		public class Y = X (|
			public c = 4.
			public d = 5.
			public e = 6.
		|) (
			public superC = (^super c)
			public superB = (^super b)
		)
	)'.
	Module:: builder install reflectee apply: Object.
	y:: Module new Y new.
	assert: y a equals: 1.
	assert: y b equals: 2.
	assert: y superC equals: 3.
	assert: y c equals: 4.
	assert: y d equals: 5.
	assert: y e equals: 6.

	(builder instanceSide nestedClasses findMirrorNamed: #Y)
		headerFromSource: 'public class Y = X (|
			public b = 7.
			public c = 4.
			public d = 5.
			public e = 6. |)';
		install.

	assert: y a equals: 1.
	assert: y superB equals: 2.
	assert: y superC equals: 3.
	assert: y c equals: 4.
	assert: y d equals: 5.
	assert: y e equals: 6.
	assert: y b equals: nil.
)
public testAddShadowedSlotSuperclass = (
	| builder Module y |
	builder:: ClassDeclarationBuilder fromSource:
	'class Module = ()(
		public class X = (| public a = 1. public b = 2. public c = 3. |) ()
		public class Y = X (| public c = 4. public d = 5. public e = 6. |) (
			public superC = (^super c)
			public superD = (^super d)
		)
	)'.
	Module:: builder install reflectee apply: Object.
	y:: Module new Y new.
	assert: y a equals: 1.
	assert: y b equals: 2.
	(*assert: y superC equals: 3. -- separate bug*)
	assert: y c equals: 4.
	assert: y d equals: 5.
	assert: y e equals: 6.

	(builder instanceSide nestedClasses findMirrorNamed: #X)
		headerFromSource: 'public class X = (| public a = 1. public b = 2. public c = 3. public d = 7. |)';
		install.

	assert: y a equals: 1.
	assert: y b equals: 2.
	(*assert: y superC equals: 3. -- separate bug*)
	assert: y superD equals: nil.
	assert: y c equals: 4.
	assert: y d equals: 5.
	assert: y e equals: 6.
)
public testAddSlot = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class TestAddSlot = ()()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	builder headerFromSource: 'class TestAddSlot = (| public x |)'.
	builder install.

	instance x: 7.
	assert: instance x equals: 7.
)
public testAddSlotAndAccessors = (
	| testClass <Class> instance <TestAddSlot_oneClass> outerMixin <Mixin> |
	testClass:: makeClass: 'class TestAddSlotAndAccessors = ()()'.
	outerMixin:: (ClassMirror reflecting: testClass) mixin reflectee.
	instance:: testClass new.
	updateMixin: outerMixin withNewDefinition: 'class TestAddSlotAndAccessors = ( | public x | ) ()'.
	assert: instance x equals: nil.
	instance x: 3.
	assert: instance x equals: 3.
)
public testChangeMethod = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class TestChangeMethod = ()( public bar = (^35) )'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	assert: instance bar equals: 35.

	builder instanceSide methods addFromSource: 'public bar = ( ^7)'.
	builder install.

	assert: instance bar equals: 7.
)
public testChangeNestedClass = (
	| testClass <Class> instance <TestChangeNestedClass> instance1 <NestedClass> outerMixin <Class> |
	testClass:: makeClass:
'class TestChangeNestedClass = ()(
	public class Nested = () (
		public bar = (^35)
	)
)'.
	outerMixin:: (ClassMirror reflecting: testClass) mixin reflectee.
	instance:: testClass new.
	instance1:: instance Nested new.

	updateMixin: outerMixin withNewDefinition:
'class TestChangeNestedClass = ()(
	public class Nested = (| public x public y = 5. |) (
		public bar = (x::7. ^x)
		public bam = (^bar*2)
	)
)'.

	assert: instance1 y equals: nil.
	assert: instance1 x equals: nil.
	assert: instance Nested new y equals: 5.
	assert: instance1 bar equals: 7.
	assert: instance1 x equals: 7.
	assert: instance1 bam equals: 14.
)
public testCreateMultipleClasses = (
	| testMixin <Class> testClass1 <Class> testClass2 <Class> testClass3 <Class> instance1 <TestCreateMultipleClasses1> instance2 <TestCreateMultipleClasses2> instance3 <TestCreateMultipleClasses3> reps <List[MixinRep]> lreps <List[LowLevelMixinRep]> testMixins <List[MixinList]> |

	reps:: {
		compileToMixinRep: 'class TestCreateMultipleClasses1 = ()( public bar = (^37) )'.
		compileToMixinRep: 'class TestCreateMultipleClasses2 = ()( public baz = (^42) )'.
		compileToMixinRep: 'class TestCreateMultipleClasses3 = ()( public foo = (^91) )'
	}.
	testMixins:: atomicInstaller install: reps withExistingMixins: Map new.

	testClass1:: (testMixins at: 1) |> Object.
	instance1:: testClass1 new.
	assert: instance1 bar equals: 37.

	testClass2:: (testMixins at: 2) |> Object.
	instance2:: testClass2 new.
	assert: instance2 baz equals: 42.

	testClass3:: (testMixins at: 3) |> Object.
	instance3:: testClass3 new.
	assert: instance3 foo equals: 91.
)
public testCreateOneClass = (
	| testClass1 <Class> instance1 <TestCreateMultipleClasses1> reps <List[MixinRep]> lreps <List[LowLevelMixinRep]> testMixins <List[MixinList]> |

	reps:: {compileToMixinRep: 'class TestCreateOneClass = ()( public bar = (^37) )'}.
	testMixins:: atomicInstaller install: reps withExistingMixins: Map new.

	testClass1:: (testMixins at: 1) |> Object.
	instance1:: testClass1 new.
	assert: instance1 bar equals: 37.
)
public testHierarchyChanges = (
	|
	superMixin1 <Mixin>
	superMixin2 <Mixin>
	superMixin3 <Mixin>
	subMixin <Mixin>
	superclass1 <Class>
	superclass2 <Class>
	superclass3 <Class>
	subclass1 <Class>
	subclass2 <Class>
	subclass3 <Class>
	subclass12 <Class>
	instance1 <TestHierarchyChanges2>
	instance2 <TestHierarchyChanges1>
	instance3 <TestHierarchyChanges3>
	instance12 <TestHierarchyChanges1>
	|
	superMixin1:: makeMixin: 'class TestHierarchyChanges1 = ()( public bar = (^37) )'.
	superMixin2:: makeMixin: 'class TestHierachyChanges2 = ()( public baz = (^42) )'.
	superMixin3:: makeMixin: 'class TestHierarchyChanges3 = ( | public z | )( public foo = (^91) )'.
	subMixin:: makeMixin: 'class TestHierarchyChanges = ( | public z | )( public foo = (^91) )'.

	superclass1:: superMixin1 |> Object.
	superclass2:: superMixin2 |> Object.
	superclass3:: superMixin3 |> Object.
	subclass1:: subMixin |> superclass1.
	subclass2:: subMixin |> superclass2.
	subclass3:: subMixin |> superclass3.
	subclass12:: superMixin1 |> subclass2.

	instance1:: subclass1 new.
	instance2:: subclass2 new.
	instance3:: subclass3 new.
	instance12:: subclass12 new.

	updateMixin: subMixin withNewDefinition:
		'class TestHierarchyChanges = ( |
			public x = 2 * bar.
			public y = x + 2.
		| )(
			public bar = (^7)
			public bam = (^x)
		)'.

	assert: [instance1 bar = 7].
	assert: [instance2 bar = 7].
	assert: [instance3 bar = 7].
	assert: [instance12 bar = 37].

	assert: [instance1 bam = nil].
	assert: [instance2 bam = nil].
	assert: [instance3 bam = nil].
	assert: [subclass12 new y = 76].
)
public testManyShapeChanges = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class Test = (| public x = 1. public y = 2. |)()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.
	assert: instance x equals: 1.
	assert: instance y equals: 2.

	(* Many shape changes without running any code from Test in between. *)
	builder headerFromSource: 'class Test = (| public w public x public y |)'.
	builder install.
	builder headerFromSource: 'class Test = (| public w public x public y public z |)'.
	builder install.
	builder headerFromSource: 'class Test = (| public w public y public z |)'.
	builder install.

	should: [instance x] signal: MessageNotUnderstood.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance y equals: 2.
	assert: instance z equals: nil.
	assert: instance w equals: nil.
)
public testMoveSlotDown = (
	| builder Module y |
	builder:: ClassDeclarationBuilder fromSource:
	'class Module = ()(
		public class X = ( | public a | ) ()
		public class Y = X ( ) ()
	)'.
	Module:: builder install reflectee apply: Object.
	y:: Module new Y new.
	assert: y a equals: nil.
	y a: 1.
	assert: y a equals: 1.

	(builder instanceSide nestedClasses findMirrorNamed: #X)
		headerFromSource: 'public class X = ()'.
	(builder instanceSide nestedClasses findMirrorNamed: #Y)
		headerFromSource: 'public class Y = X ( | public a | )'.

	builder install.
	assert: y a equals: nil. (* Not 1 *)
	y a: 1.
	assert: y a equals: 1.
)
public testMoveSlotUp = (
	| builder Module y |
	builder:: ClassDeclarationBuilder fromSource:
	'class Module = ()(
		public class X = () ()
		public class Y = X ( | public a | ) ()
	)'.
	Module:: builder install reflectee apply: Object.
	y:: Module new Y new.
	assert: y a equals: nil.
	y a: 1.
	assert: y a equals: 1.

	(builder instanceSide nestedClasses findMirrorNamed: #X)
		headerFromSource: 'public class X = (| public a |)'.
	(builder instanceSide nestedClasses findMirrorNamed: #Y)
		headerFromSource: 'public class Y = X ()'.

	builder install.
	assert: y a equals: nil. (* Not 1 *)
	y a: 1.
	assert: y a equals: 1.
)
public testMultipleChanges = (
	| builder1 builder2 builder3 klass1 klass2 klass3 instance1 instance2 instance3 |
	builder1:: ClassDeclarationBuilder fromSource:
		'class TestMultipleChanges1 = ()( public bar = (^37) )'.
	builder2:: ClassDeclarationBuilder fromSource:
		'class TestMultipleChanges2 = ()( public baz = (^42) )'.
	builder3:: ClassDeclarationBuilder fromSource:
		'class TestMultipleChanges3 = ( | public z | )( public foo = (^91) )'.
	mirrors installAtomically: {builder1. builder2. builder3}.
	klass1:: builder1 reflectee apply: Object.
	klass2:: builder2 reflectee apply: Object.
	klass3:: builder3 reflectee apply: Object.
	instance1:: klass1 new.
	instance2:: klass2 new.
	instance3:: klass3 new.

	assert: instance1 bar equals: 37.
	assert: instance2 baz equals: 42.
	assert: instance3 foo equals: 91.
	assert: instance3 z equals: nil.

	builder1 instanceSide methods addFromSource: 'public bar = (^7)'.
	builder2 instanceSide methods
		addFromSource: 'public baz = (^91)';
		addFromSource: 'public bar = (^baz + 17)'.
	builder3 headerFromSource: 'class TestMultipleChanges3 = ( |
		public x = 2 * bar.
		public y = x + 2. | )'.
	builder3 instanceSide methods
		addFromSource: 'public bar = (^7)';
		addFromSource: 'public bam = (^x) )';
		removeMirrorNamed: #foo.
	mirrors installAtomically: {builder1. builder2. builder3}.

	assert: instance1 bar equals: 7.
	assert: instance2 bar equals: 108.
	assert: instance2 baz equals: 91.
	assert: instance3 bam equals: nil.
	assert: klass3 new bam equals: 14.
	assert: klass3 new y equals: 16.
	should: [klass3 new z] signal: MessageNotUnderstood.
	should: [klass3 new foo] signal: MessageNotUnderstood.
)
public testNesting = (
	| outerClass0 <Class> outerMixin0 <Class> instance0 <TestNesting>
	nestedClass1 <Class> nestedMixin1 <Class> nestedClass11 <Class>
	nestedMixin11 <Class>
	instance1 <Nested1> instance11 <Nested11>
	nestedClass111 <Class> nestedMixin111 <Class> instance111 <Nested111>
	rep <MixinRep>
	|
	outerClass0:: makeClass:
'class TestNesting = () (
	public class Nested1 = ( | a b c | ) (
		public class Nested11 = () (
			public class Nested111 = ( | x = a. |) ()
		)
		public class Nested12 = Nested11 () ()
	)
	public class Nested2 = () (
	)
)'.
	outerMixin0:: (ClassMirror reflecting: outerClass0) mixin reflectee.
	instance0:: outerClass0 new.
	nestedClass1:: instance0 Nested1.
	instance1:: nestedClass1 new.
	nestedClass11:: instance1 Nested11.
	instance11:: nestedClass11 new.
	nestedClass111:: instance11 Nested111.
	instance111:: nestedClass111 new.

	updateMixin: outerMixin0 withNewDefinition:
'class TestNesting = () (
	public class Nested1 = ( | public d public e = 5. | ) (
		public class Nested11 = () (
			public class Nested111 = ( | public z = e. |) ()
			public bar = (^7)
		)
		public class Nested12 = Nested11 () ()
		public class Nested13 = Nested12() ()
	)
	public class Nested3 = Nested1 ()()
)'.

	assert: instance111 z equals: nil.
	assert: instance11 bar equals: 7.
	assert: instance1 d equals: nil.
	assert: instance1 e equals: nil.
	assert: instance1 Nested12 new bar equals: 7.
	assert: instance0 Nested3 new Nested12 new Nested111 new z equals: 5.
)
public testNoShapeChangeThenShapeChange = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class Test = (| public x = 1. public y = 2. |)()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	should: [instance z] signal: MessageNotUnderstood.
	should: [instance w] signal: MessageNotUnderstood.

	builder instanceSide methods addFromSource: 'public z = (^3)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 3.
	should: [instance w] signal: MessageNotUnderstood.

	builder headerFromSource: 'class Test = (| public x public y public w |)'.
	builder instanceSide methods addFromSource: 'public z = (^4)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 4.
	assert: instance w equals: nil.
)
public testObjectsRetainIdentityHash = (
	| builder klass instance originalKlassHash originalInstanceHash |
	builder:: ClassDeclarationBuilder fromSource: 'class Test = (| public x public y |)()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.
	originalKlassHash:: klass identityHash.
	originalInstanceHash:: instance identityHash.

	builder headerFromSource: 'class Test = (| public x public y public z |)'.
	builder install.
	instance z. (* Should not raise MNU. *)
	assert: klass identityHash equals: originalKlassHash.
	assert: instance identityHash equals: originalInstanceHash.
)
public testRebuildIntermediatesFromRuntime = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource:
'class M f: w = (| x = 3. y ::= w. |)(
	class C = (| z = 1. w ::= 5. |)(
		class I = ()()
		baz = (^43)
	) : (
		quz = (^41)
	)
	bar = (^42)
) : (
	foo = (^40)
)'.

	klass:: builder install reflectee apply: Object.

	builder:: ClassDeclarationBuilder reflecting: klass mixin.
	builder install.
)
public testRemoveMethod = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource:
		'class TestRemoveMethod = ()( public bar = (^35) )'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	assert: instance bar equals: 35.

	builder instanceSide methods removeMirrorNamed: #bar.
	builder install.

	should: [instance bar] signal: MessageNotUnderstood.
)
public testRemoveNestedClass = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource:
'class TestRemoveNestedClass = ()(
	public class Nested = () (
		public bar = (^35)
	)
)'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	assert: instance Nested isBehavior.
	assert: instance Nested new bar equals: 35.

	builder instanceSide nestedClasses removeMirrorNamed: #Nested.
	builder install.

	should: [instance Nested] signal: MessageNotUnderstood.
)
public testRemoveNestedNestedClass = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource:
'class TestRemoveNestedNestedClass = ()(
	public class Nested = () (
		public class NestedNested = ()()
		public bar = (^35)
	)
)'.
	klass:: (builder install reflectee apply: Object) new Nested.
	instance:: klass new.

	assert: instance NestedNested isBehavior.
	assert: instance bar equals: 35.

	(builder instanceSide nestedClasses findMirrorNamed: #Nested)
		instanceSide nestedClasses removeMirrorNamed: #NestedNested.
	builder install.

	should: [instance NestedNested] signal: MessageNotUnderstood.
	assert: instance bar equals: 35.
)
public testRemoveSlot = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class TestRemoveSlot = ( | public x | )()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.

	instance x: 7.
	assert: instance x equals: 7.

	builder headerFromSource: 'class TestRemoveSlot = ()'.
	builder install.

	should: [instance x] signal: MessageNotUnderstood.
)
public testShapeChangeThenNoShapeChange = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class Test = (| public x = 1. public y = 2. |)()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	should: [instance z] signal: MessageNotUnderstood.
	should: [instance w] signal: MessageNotUnderstood.

	builder headerFromSource: 'class Test = (| public x public y public w |)'.
	builder instanceSide methods addFromSource: 'public z = (^3)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 3.
	assert: instance w equals: nil.

	builder instanceSide methods addFromSource: 'public z = (^4)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 4.
	assert: instance w equals: nil.
)
public testShapeChangeThenShapeChange = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class Test = (| public x = 1. public y = 2. |)()'.
	klass:: builder install reflectee apply: Object.
	instance:: klass new.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	should: [instance z] signal: MessageNotUnderstood.
	should: [instance w] signal: MessageNotUnderstood.
	should: [instance v] signal: MessageNotUnderstood.

	builder headerFromSource: 'class Test = (| public x public y public w |)'.
	builder instanceSide methods addFromSource: 'public z = (^3)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 3.
	assert: instance w equals: nil.
	should: [instance v] signal: MessageNotUnderstood.

	builder headerFromSource: 'class Test = (| public x public y public w public v |)'.
	builder instanceSide methods addFromSource: 'public z = (^4)'.
	builder install.
	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance x equals: 1.
	assert: instance y equals: 2.
	assert: instance z equals: 4.
	assert: instance w equals: nil.
	assert: instance v equals: nil.
)
public testStressfulShapeChange = (
	| builder klass instance |
	builder:: ClassDeclarationBuilder fromSource: 'class Shapeshifter = ()()'.
	klass:: builder install reflectee apply: Object.
	builder headerFromSource: 'class Shapeshifter = ( |
		public one = 1.
		public two = 2.
		public three = 3. | )'.
	builder install.
	instance:: klass new.

	builder headerFromSource: 'class Shapeshifter = ( |
		public three = 3.
		public four = 4.
		public five = 5.
		public two = 2. | )'.
	builder install.

	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance three equals: 3.
	assert: instance two equals: 2.
	assert: instance four equals: nil.
	assert: instance five equals: nil.
	should: [instance one] signal: MessageNotUnderstood.

	builder headerFromSource: 'class Shapeshifter = ( |
		public six = 6.
		public three = 3. |)'.
	builder install.

	assert: instance isInstanceOf: klass.
	assert: instance isOnlyInstanceOf: klass.
	assert: instance three equals: 3.
	assert: instance six equals: nil.
	should: [instance one] signal: MessageNotUnderstood.
	should: [instance two] signal: MessageNotUnderstood.
	should: [instance four] signal: MessageNotUnderstood.
	should: [instance five] signal: MessageNotUnderstood.
)
public testSubclass = (
	(* Test the effect of modifying a subclass of an unmodified but non-trivial superclass. *)
	|
	superMixin <Class>
	subMixin <Class>
	superClass <Class>
	subClass <Class>
	objectSubClass <Class>
	instanceSuper <TestSubclassSuper>
	instanceSub <TestSubclassSub>
	instanceObjectSub <TestSubclassSub>
	|
	superMixin:: makeMixin: 'class TestSubclassSuper = ( | public z | )( public foo = (^91) )'.
	superClass:: superMixin |> Object.
	subMixin:: makeMixin: 'class TestSubclassSub = ()( public bar = (^37) )'.
	subClass:: subMixin |> superClass.
	objectSubClass:: subMixin |> Object.
	instanceSuper:: superClass new.
	instanceSub:: subClass new.
	instanceObjectSub:: objectSubClass new.

	assert: [instanceSuper foo = 91].
	assert: [instanceSub foo = 91].
	assert: [instanceSuper z isNil].
	assert: [instanceSub z isNil].
	assert: [instanceObjectSub bar = 37].
	assert: [instanceSub bar = 37].

	updateMixin: subMixin withNewDefinition:
		'class TestSubclassSub = ( | public x ::= 2 * bar. public y = x + 2. | )(
			public bar = (^7)
			public bam = (^x)
		)'.

	assert: [instanceSuper foo = 91].
	assert: [instanceSub foo = 91].
	assert: [instanceSuper z isNil].
	assert: [instanceSub z isNil].
	assert: [instanceObjectSub bar = 7].
	assert: [instanceSub bar = 7].
	assert: [instanceObjectSub bam isNil].

	instanceObjectSub x: 3.
	assert: [instanceObjectSub bam = 3].
	assert: [instanceSub bam isNil].

	instanceSub x: 5.
	assert: [instanceSub bam = 5].
	assert: [subClass new x = 14].
	assert: [objectSubClass new x = 14].
	assert: [subClass new y = 16].
	assert: [objectSubClass new y = 16].
)
public testSuperAndSubclass = (
	(* Test the effect of simultaneously modifying a superclass and a subclass. *)
	|
	superMixin <Mixin>
	subMixin <Mixin>
	superClass <Class>
	subClass <Class>
	objectSubClass <Class>
	instanceSuper <TestSuperclassSuper>
	instanceSub <TestSuperclassSub>
	instanceObjectSub <TestSuperclassSub>
	|
	superMixin:: makeMixin: 'class TestSuperAndSubclassSuper = ( | public z | )( public foo = (^91) )'.
	subMixin:: makeMixin: 'class TestSuperAndSubclassSub = ()( public bar = (^37) )'.
	superClass:: superMixin |> Object.
	subClass:: subMixin |> superClass.
	objectSubClass:: subMixin |> Object.
	instanceSuper:: superClass new.
	instanceSub:: subClass new.
	instanceObjectSub:: objectSubClass new.

	assert: [instanceSuper foo = 91].
	assert: [instanceSub foo = 91].
	assert: [instanceSuper z isNil].
	assert: [instanceSub z isNil].
	assert: [instanceObjectSub bar = 37].
	assert: [instanceSub bar = 37].

	updateMixins: {superMixin. subMixin} withNewDefinitions: {
		'class TestSuperAndSubclassSuper = ( | public w ::= bar*3. | )(
			public bar = (^7)
			public bam = (^w)
		)'.
		'class TestSuperAndSubclassSub = ( | public x = 2 * bar. public y = x + 2. | )(
			public bar = (^39)
			public baz = (^x + y)
		)'.
	}.
	assert: [instanceSuper bar = 7].
	assert: [instanceObjectSub bar = 39].
	assert: [instanceSub bar = 39].
	assert: [instanceSuper bam isNil].

	instanceSuper w: 3.
	assert: [instanceSuper bam = 3].
	assert: [instanceSub bam isNil].

	instanceSub w: 5.
	assert: [instanceSub bam = 5].
	assert: [superClass new w = 21].
	assert: [subClass new x = 78].
	assert: [subClass new w = 117].
	assert: [superClass new bam = 21].
	assert: [subClass new bam = 117].
	assert: [objectSubClass new baz = 158].
	assert: [subClass new baz = 158].
	assert: [objectSubClass new y = 80].
	assert: [subClass new y = 80].
)
public testSuperclass = (
	(* Test the effect of modifying the superclass of an umodified subclass. *)
	|
	superMixin <Mixin>
	subMixin <Mixin>
	superClass <Class>
	subClass <Class>
	objectSubClass <Class>
	instanceSuper <TestSuperclassSub>
	instanceSub <TestSuperclassSub>
	instanceObjectSub
	|
	superMixin:: makeMixin: 'class TestSuperclassSuper = ( | public z | )( public foo = (^91) )'.
	superClass:: superMixin |> Object.
	subMixin:: makeMixin: 'class TestSuperclassSub = ()( public bar = (^37) )'.
	subClass:: subMixin |> superClass.
	objectSubClass:: subMixin |> Object.

	instanceSuper:: superClass new.
	instanceSub:: subClass new.
	instanceObjectSub:: objectSubClass new.

	assert: [instanceSuper foo = 91].
	assert: [instanceSub foo = 91].
	assert: [instanceSuper z isNil].
	assert: [instanceSub z isNil].
	assert: [instanceSub bar = 37].
	assert: [instanceObjectSub bar = 37].

	updateMixin: superMixin withNewDefinition:
		'class TestSuperclassSuper = ( | public x ::= 2 * bar. public y = x + 2. | )(
			public bar = (^7)
			public bam = (^x)
		)'.

	assert: [instanceSuper bar = 7].
	assert: [instanceObjectSub bar = 37].
	assert: [instanceSub bar = 37].
	assert: [instanceSuper bam isNil].
	assert: [instanceSub bam isNil].

	instanceSub x: 5.

	assert: [instanceSub bam = 5].
	assert: [superClass new x = 14].
	assert: [subClass new x = 74].
	assert: [superClass new y = 16].
	assert: [subClass new y = 76].
)
updateMixin: mixin <Mixin> withNewDefinition: source <String> = (
(* Compile the source string (a complete source of the class) as a replacement of an existing mixin. Install the replacement. *)
	| newRep existingMixinMap |
	newRep:: compileToMixinRep: source.
	existingMixinMap:: Map new.
	existingMixinMap at: newRep put: mixin.
(*	existingMixinMap at: newRep last first put: mixin nestedMixins anyOne. *)
	atomicInstaller install: {newRep} withExistingMixins: existingMixinMap.
)
updateMixins: mixins <{Mixin}> withNewDefinitions: sources <{String}> = (
(* Compile the source string (a complete source of the class) as a replacement of existing mixins. Atomically install the replacements. *)
	| newReps existingMixinMap |
	assert: [mixins size = sources size].
	newReps:: sources collect: [:each | compileToMixinRep: each].
	existingMixinMap:: Map new.
	newReps with: mixins do:
		[:eachRep :eachMixin |
		existingMixinMap at: eachRep put: eachMixin].
	atomicInstaller install: newReps withExistingMixins: existingMixinMap.
)
) : (
TEST_CONTEXT = ()
)
) : (
)