MirrorBuilderTesting.ns

Newspeak3
'Root'
class MirrorBuilderTesting usingPlatform: p testFramework: m = (|
private ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder.
private ClassMirror = p mirrors ClassMirror.
private ObjectMirror = p mirrors ObjectMirror.
private MessageNotUnderstood = p kernel MessageNotUnderstood.
private Map = p collections Map.
private TestContext = m TestContext.
|) (
public class ClassDeclarationBuilderTests = TestContext () (
classFromSource: src <String> ^<Class> = (
	^(ClassDeclarationBuilder fromSource: src) install applyToObject reflectee
)
conflictError = (
	^Error
)
in: collection findMirrorNamed: name = (
	collection do: [:mirror | mirror name = name ifTrue: [^mirror]].
	^nil
)
syntaxError = (
	^Error
)
public testAccessModifiersFromClass = (
	| klass builder |
	klass:: classFromSource:
		'class Top = (| public slotA protected slotB private slotC slotD |)(
			public class ClassA = ()()
			protected class ClassB = ()()
			private class ClassC = ()()
			class ClassD = ()()
			public methodA = ()
			protected methodB = ()
			private methodC = ()
			methodD = ()
		)'.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.

	assert: builder accessModifier equals: #public.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotA) accessModifier equals: #public.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotB) accessModifier equals: #protected.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotC) accessModifier equals: #private.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotD) accessModifier equals: #protected.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassA) accessModifier equals: #public.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassB) accessModifier equals: #protected.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassC) accessModifier equals: #private.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassD) accessModifier equals: #protected.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodA) accessModifier equals: #public.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodB) accessModifier equals: #protected.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodC) accessModifier equals: #private.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodD) accessModifier equals: #protected.
)
public testAccessModifiersFromSource = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource:
		'class Top = (| public slotA protected slotB private slotC slotD |)(
			public class ClassA = ()()
			protected class ClassB = ()()
			private class ClassC = ()()
			class ClassD = ()()
			public methodA = ()
			protected methodB = ()
			private methodC = ()
			methodD = ()
		)'.

	assert: builder accessModifier equals: #public.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotA) accessModifier equals: #public.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotB) accessModifier equals: #protected.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotC) accessModifier equals: #private.
	assert: (in: builder instanceSide slots findMirrorNamed: #slotD) accessModifier equals: #protected.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassA) accessModifier equals: #public.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassB) accessModifier equals: #protected.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassC) accessModifier equals: #private.
	assert: (in: builder instanceSide nestedClasses findMirrorNamed: #ClassD) accessModifier equals: #protected.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodA) accessModifier equals: #public.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodB) accessModifier equals: #protected.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodC) accessModifier equals: #private.
	assert: (in: builder instanceSide methods findMirrorNamed: #methodD) accessModifier equals: #protected.
)
public testChangeObject = (
	(* Object is an edge case for Primordial Soup (has nil superclass) and Newspeak-on-Squeak (has a Smalltalk superclass. *)
	|
	instance
	builder <ClassDeclarationBuilder>
	|
	instance:: Object new.
	should: [instance foo] signal: MessageNotUnderstood.

	builder:: (ObjectMirror reflecting: instance) getClass mixin declaration asBuilder.
	builder instanceSide methods addFromSource: 'public foo = (^1984)'.
	builder install.
	assert: instance foo equals: 1984.

	builder instanceSide methods removeMirrorNamed: #foo.
	builder install.
	should: [instance foo] signal: MessageNotUnderstood.
)
public testChangeSmallInteger = (
	(* SmallInteger is an edge case for Primordial Soup because it has a fixed CID. *)
	|
	instance
	builder <ClassDeclarationBuilder>
	|
	instance:: 0.
	should: [instance foo] signal: MessageNotUnderstood.

	builder:: (ObjectMirror reflecting: instance) getClass mixin declaration asBuilder.
	builder instanceSide methods addFromSource: 'public foo = (^1984)'.
	builder install.
	assert: instance foo equals: 1984.

	builder instanceSide methods removeMirrorNamed: #foo.
	builder install.
	should: [instance foo] signal: MessageNotUnderstood.
)
public testClassDeclAddMethod = (
	(* add a new method *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class EmptyClass = ()()'.
	instance:: klass new.
	should: [instance foo: 3] signal: MessageNotUnderstood.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide methods addFromSource: 'public foo: x = (^x * x)'.
	should: [instance foo: 3] signal: MessageNotUnderstood.
	builder install.
	assert: (instance foo: 3) equals: 9.
)
public testClassDeclAddNestedClass = (
	(* add a new nested class decl *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class EmptyClass = ()()'.
	instance:: klass new.
	should: [instance Nested] signal: MessageNotUnderstood.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide nestedClasses addFromSource: 'public class Nested = ()( public foo = (^91) )'.
	should: [instance Nested] signal: MessageNotUnderstood.
	builder install.
	assert: instance Nested new foo equals: 91.
)
public testClassDeclAddSlot = (
	(* add a new slot *)
	|
	klass <Class>
	instance <Object>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class EmptyClass = ()()'.
	instance:: klass new.
	should: [instance newSlot] signal: MessageNotUnderstood.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class EmptyClass = ( | public newSlot ::= 91. | )'.
	should: [instance newSlot] signal: MessageNotUnderstood.
	builder install.
	instance:: klass new.
	assert: instance newSlot equals: 91.
	instance newSlot: 101.
	assert: instance newSlot equals: 101.
)
public testClassDeclCopyNested = (
	(* The bug here seems to be the copy doesn't get its qualified name patched. *)
	|
	topBuilder <ClassDeclarationBuilder>
	topClass
	origBuilder
	origMirror
	copyBuilder
	copySource
	copyMirror
	topMirror
	|
	topBuilder:: ClassDeclarationBuilder fromSource: 'class Top = ()()'.
	topClass:: topBuilder install applyToObject reflectee.

	origBuilder:: topBuilder instanceSide nestedClasses addFromSource: 'class TheOriginal = ()()'.
	origMirror:: origBuilder install.
	assert: origMirror name equals: 'TheOriginal'.
	assert: origMirror accessModifier equals: #protected.

	copyBuilder:: ClassDeclarationBuilder fromSource: origMirror source.
	copyBuilder header name: 'TheCopy'.
	copySource:: copyBuilder source.
	copyBuilder:: topBuilder instanceSide nestedClasses addFromSource: copySource.
	copyMirror:: copyBuilder install.
	assert: copyMirror name equals: 'TheCopy'.
	assert: copyMirror accessModifier equals: #protected.

	assert: origMirror name equals: 'TheOriginal'. (* Unchanged *)
	assert: origMirror accessModifier equals: #protected.

	topMirror:: (ClassMirror reflecting: topClass) mixin declaration.
	(* Both nested classes are present. *)
	assert: (in: topMirror instanceSide nestedClasses findMirrorNamed: #TheOriginal) accessModifier equals: #protected.
	assert: (in: topMirror instanceSide nestedClasses findMirrorNamed: #TheCopy) accessModifier equals: #protected.
)
public testClassDeclCopyTopLevel = (
	|
	origBuilder
	origMirror
	origClass
	copyBuilder
	copyMirror
	copyClass
	|
	origBuilder:: ClassDeclarationBuilder fromSource: 'class TheOriginal = ()()'.
	origClass:: origBuilder install applyToObject reflectee.
	origMirror:: (ClassMirror reflecting: origClass) mixin declaration.
	assert: origMirror name equals: 'TheOriginal'.
	assert: origMirror accessModifier equals: #public.

	copyBuilder:: ClassDeclarationBuilder fromSource: origMirror source.
	copyBuilder header name: 'TheCopy'.
	copyClass:: copyBuilder install applyToObject reflectee.
	copyMirror:: (ClassMirror reflecting: copyClass) mixin declaration.
	assert: copyMirror name equals: 'TheCopy'.
	assert: copyMirror accessModifier equals: #public.

	assert: origMirror name equals: 'TheOriginal'. (* Unchanged *)
	assert: origMirror accessModifier equals: #public.
)
public testClassDeclModifySlot = (
	(* modify the declaration of an existing slot *)
	|
	klass <Class>
	instance <Object>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclModifySlot = ( | public x ::= 117. public y = 0. public z | )()'.
	instance:: klass new.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class TestClassDeclModifySlot = ( | public x ::= 120. public y = 0. public z | )'.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	builder install.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	instance:: klass new.
	assert: instance x equals: 120.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
)
public testClassDeclRemoveMethod = (
	(* remove an existing method *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclRemoveMethod = ()(
		public foo = (^91)
		public bar = (^42)
	)'.
	instance:: klass new.
	assert: instance foo equals: 91.
	assert: instance bar equals: 42.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide methods removeMirrorNamed: #foo.
	assert: instance foo equals: 91.
	assert: instance bar equals: 42.
	builder install.
	should: [instance foo] signal: MessageNotUnderstood.
	assert: instance bar equals: 42.
)
public testClassDeclRemoveNestedClass = (
	(* remove an existing nested class *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclRemoveNestedClass = ()(
		public class Nested = ()() : ( public foo = (^70) )
	)'.
	instance:: klass new.
	assert: instance Nested foo equals: 70.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide nestedClasses removeMirrorNamed: #Nested.
	assert: instance Nested foo equals: 70.
	builder install.
	should: [instance Nested] signal: MessageNotUnderstood.
)
public testClassDeclRemoveNonExistentMethod = (
	(* remove a non-existing method. The effect should be to do nothing, so our only goal here is to run without error *)
	|
	klass <Class>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclRemoveMethod = ()(
		foo = (^91)
	      bar = (^42)
	)'.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide methods removeMirrorNamed: #baz.
)
public testClassDeclRemoveNonExistentNestedClass = (
	(* remove a non-existing nested class. The effect should be to do nothing, so our only goal here is to run without error *)
	|
	klass <Class>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclRemoveNonExistantNestedClass = ()()'.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide nestedClasses removeMirrorNamed: #Nested.
)
public testClassDeclRemoveSlot = (
	(* remove an existing slot *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclRemoveSlot = ( | public x ::= 117. public y = 0. public z | )()'.
	instance:: klass new.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class TestClassDeclRemoveSlot = ( | public x ::= 117. public y = 0. | )'.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	builder install.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	should: [instance z] signal: MessageNotUnderstood.
)
public testClassDeclRenameNested = (
	|
	enclosingBuilder <ClassDeclarationBuilder>
	enclosingClass
	cls
	builder
	|
	enclosingBuilder:: ClassDeclarationBuilder fromSource:
'class Enclosing = ()(
	class OldName = ()()
	public getOldName = (^self OldName)
)'.
	enclosingClass:: enclosingBuilder install applyToObject reflectee.
	cls:: enclosingClass new getOldName.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'OldName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #protected.

	builder:: (ClassMirror reflecting: cls) mixin declaration asBuilder.
	builder header name: 'NewName'.
	builder install.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'NewName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #protected.
)
public testClassDeclRenameNestedPrivate = (
	|
	enclosingBuilder <ClassDeclarationBuilder>
	enclosingClass
	cls
	builder
	|
	enclosingBuilder:: ClassDeclarationBuilder fromSource:
'class Enclosing = ()(
	private class OldName = ()()
	public getOldName = (^self OldName)
)'.
	enclosingClass:: enclosingBuilder install applyToObject reflectee.
	cls:: enclosingClass new getOldName.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'OldName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #private.

	builder:: (ClassMirror reflecting: cls) mixin declaration asBuilder.
	builder header name: 'NewName'.
	builder install.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'NewName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #private.
)
public testClassDeclRenameTopLevel = (
	|
	builder <ClassDeclarationBuilder>
	cls
	builder2
	|
	builder:: ClassDeclarationBuilder fromSource: 'class OldName = ()()'.
	cls:: builder install applyToObject reflectee.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'OldName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #public.

	builder2:: (ClassMirror reflecting: cls) mixin declaration asBuilder.
	builder2 header name: 'NewName'.
	builder2 install.

	assert: (ClassMirror reflecting: cls) mixin name equals: 'NewName'.
	assert: (ClassMirror reflecting: cls) mixin declaration accessModifier equals: #public.
)
public testClassDeclReplaceMethod = (
	(* replace an existing method *)
	|
	klass <Class>
	instance
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclReplaceMethod = ()(
		public foo = (^#before)
	)'.
	instance:: klass new.
	assert: instance foo equals: #before.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide methods addFromSource: 'public foo = (^#after)'.
	assert: instance foo equals: #before.
	builder install.
	assert: instance foo equals: #after.
)
public testClassDeclReplaceNestedClass = (
	(* replace an existing nested class *)
	|
	builder
	klass
	instance
	nestedKlass
	|

	klass:: classFromSource: 'class TestClassDeclReplaceNestedClass = ()(
		public class Nested = ()() : ( public foo = (^#before) )
	)'.
	instance:: klass new.
	nestedKlass:: instance Nested.
	assert: nestedKlass foo equals: #before.
	assert: instance Nested foo equals: #before.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder instanceSide nestedClasses addFromSource:
'public class Nested = ()() : ( public foo = (^#after) )'.
	assert: nestedKlass foo equals: #before.
	assert: instance Nested foo equals: #before.

	builder install.
	assert: nestedKlass foo equals: #before.
	assert: instance Nested foo equals: #before.

	assert: klass new Nested foo equals: #after.
)
public testClassDeclReplaceSlot = (
	(* replace an existing slot *)
	|
	klass <Class>
	instance <Object>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class TestClassDeclReplaceSlot = ( | public x ::= 117. public y = 0. public z | )()'.
	instance:: klass new.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	should: [instance a] signal: MessageNotUnderstood.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class TestClassDeclReplaceSlot = ( | public a ::= 120. public y = 0. public z | )'.
	assert: instance x equals: 117.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	should: [instance a] signal: MessageNotUnderstood.
	builder install.
	should: [instance x] signal: MessageNotUnderstood.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	assert: instance a equals: nil.
	instance:: klass new.
	should: [instance x] signal: MessageNotUnderstood.
	assert: instance y equals: 0.
	assert: instance z equals: nil.
	assert: instance a equals: 120.
)
public testClassDeclSource = (
	(* Note: We preserve exact class headers and methods, but not whole class declarations. *)
	|
	headerSource
	nestedHeaderSource
	methodSource
	klass <Class>
	builder <ClassDeclarationBuilder>
	mirror <ClassMirror>
	|

	headerSource:: 'class Foo = (
		|
		bar
		baz
		|
	)'.
	nestedHeaderSource:: 'class Nested = (
		| hest fisk |
	)'.
	methodSource:: 'public main = ()'.

	builder:: ClassDeclarationBuilder fromSource:
		headerSource, '(', nestedHeaderSource, '()', methodSource, ')'.
	assert: (builder source indexOf: headerSource) > 0.
	assert: (builder source indexOf: nestedHeaderSource) > 0.
	assert: (builder source indexOf: methodSource) > 0.

	klass:: builder install applyToObject reflectee.
	mirror:: ClassMirror reflecting: klass.
	assert: (mirror mixin declaration source indexOf: headerSource) > 0.
	assert: (mirror mixin declaration source indexOf: nestedHeaderSource) > 0.
	assert: (mirror mixin declaration source indexOf: methodSource) > 0.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	assert: (builder source indexOf: headerSource) > 0.
	assert: (builder source indexOf: nestedHeaderSource) > 0.
	assert: (builder source indexOf: methodSource) > 0.
)
public testClassHeaderComment = (
	(* Note: We preserve exact class headers and methods, but not whole class declarations. *)
	|
	comment
	headerSource
	klass <Class>
	builder <ClassDeclarationBuilder>
	mirror <ClassMirror>
	|

	comment:: ' This is the (* nested *) comment. '.
	headerSource:: 'class Foo = (
		(*', comment, '*)
	)'.

	builder:: ClassDeclarationBuilder fromSource: headerSource, '()'.
	assert: builder header classComment equals: comment.

	klass:: builder install applyToObject reflectee.
	mirror:: ClassMirror reflecting: klass.
	assert: mirror mixin declaration header classComment equals: comment.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	assert: builder header classComment equals: comment.
)
public testClassHeaderPreamble = (
	(* Note: We preserve exact class headers and methods, but not whole class declarations. *)
	|
	preamble
	headerSource
	klass <Class>
	builder <ClassDeclarationBuilder>
	mirror <ClassMirror>
	|

	preamble:: 'class Foo foo: x = Bar bar: x'.
	headerSource:: preamble, ' (
		|
		bar
		baz
		|
	)'.

	builder:: ClassDeclarationBuilder fromSource: headerSource, '()'.
	assert: builder header preamble equals: preamble.

	klass:: builder install applyToObject reflectee.
	mirror:: ClassMirror reflecting: klass.
	assert: mirror mixin declaration header preamble equals: preamble.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	assert: builder header preamble equals: preamble.
)
public testClassHeaderSource = (
	(* Note: We preserve exact class headers and methods, but not whole class declarations. *)
	|
	headerSource
	klass <Class>
	builder <ClassDeclarationBuilder>
	mirror <ClassMirror>
	|

	headerSource:: 'class Foo = (
		|
		bar
		baz
		|
	)'.

	builder:: ClassDeclarationBuilder fromSource: headerSource, '()'.
	assert: builder header source equals: headerSource.

	klass:: builder install applyToObject reflectee.
	mirror:: ClassMirror reflecting: klass.
	assert: mirror mixin declaration header source equals: headerSource.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	assert: builder header source equals: headerSource.
)
public testConflictingFactoryOverMethod = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()() : ( foo = () )'.
	should: [builder header source: 'class Conflicted foo = ()'] signal: conflictError.
)
public testConflictingMethodOverFactory = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted foo = ()()'.
	should: [builder classSide methods addFromSource: 'foo = ()'] signal: conflictError.
)
public testConflictingMethodOverNestedClass = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()(
		class foo = ()()
	)'.
	should: [builder instanceSide methods addFromSource: 'foo = ()'] signal: conflictError.
)
public testConflictingMethodOverSlot = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = (| foo bar = 1. |)()'.
	should: [builder instanceSide methods addFromSource: 'foo = ()'] signal: conflictError.
	should: [builder instanceSide methods addFromSource: 'foo: x = ()'] signal: conflictError.
	should: [builder instanceSide methods addFromSource: 'bar = ()'] signal: conflictError.
	builder instanceSide methods addFromSource: 'bar: x = ()'.
)
public testConflictingNestedClassFromRename = (
	| builder nested |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()(
		class Nested1 = ()()
		class Nested2 = ()()
	)'.
	nested:: in: builder instanceSide nestedClasses findMirrorNamed: #Nested1.
	should: [nested name: #Nested1] signal: conflictError.
)
public testConflictingNestedClassOverMethod = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()( foo = () )'.
	should: [builder instanceSide nestedClasses addFromSource: 'class foo = ()()'] signal: conflictError.
)
public testConflictingNestedClassOverMethodFromRename = (
	| builder nested |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()(
		class Nested = ()()
		foo = ()
	)'.
	nested:: in: builder instanceSide nestedClasses findMirrorNamed: #Nested.
	should: [nested name: #foo] signal: conflictError.
)
public testConflictingNestedClassOverSlot = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = (| foo |)()'.
	should: [builder instanceSide nestedClasses addFromSource: 'class foo = ()()'] signal: conflictError.
)
public testConflictingNestedClassOverSlotFromRename = (
	| builder nested |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = (| foo |)(
		class Nested = ()()
	)'.
	nested:: in: builder instanceSide nestedClasses findMirrorNamed: #Nested.
	should: [nested name: #foo] signal: conflictError.
)
public testConflictingSlotOverMethod = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()(
		foo = ()
	)'.
	should: [builder header source: 'Conflicted = (| foo |)'] signal: conflictError.
)
public testConflictingSlotOverNestedClass = (
	| builder |
	builder:: ClassDeclarationBuilder fromSource: 'class Conflicted = ()(
		class foo = ()()
	)'.
	should: [builder header source: 'Conflicted = (| foo |)'] signal: conflictError.
)
public testEvaluateEmptyString = (
	| thread |
	thread:: (ObjectMirror reflecting: self) evaluate: ''.
	assert: thread isFulfilled.
	assert: thread result reflectee equals: self.
)
public testEvaluateWithScope = (
	| scope thread |
	scope:: Map new.
	scope at: #x put: (ObjectMirror reflecting: 42).
	scope at: #y put: (ObjectMirror reflecting: 2).
	thread:: (ObjectMirror reflecting: self) evaluate: 'x - y' with: scope.
	assert: thread isFulfilled.
	assert: thread result reflectee equals: 40.
)
public testIncrementalScopeBuilding = (
	(* add a new method *)
	|
	builder <ClassDeclarationBuilder>
	klass <Class>
	ooter
	inner
	thread
	|
	builder:: ClassDeclarationBuilder fromSource:
'class Outer = ( | public outerSlot = 1. | )(
	public class Inner = ( | public innerSlot = 3. | )(
		public class InnerInner = ()()
		public innerMethod = (^4)
	)
	public class Sibling = ()()
	public outerMethod = (^2)
)'.
	klass:: builder install applyToObject reflectee.
	ooter:: klass new.
	inner:: ooter Inner new.

	(* Incremental eval *)
	thread:: (ObjectMirror reflecting: inner) evaluate:
		'{outer Outer. outerSlot. outerMethod. outer Inner. innerSlot. innerMethod. Inner. Sibling. InnerInner}'.
	assert: thread isFulfilled.
	assertList: thread result reflectee equals: {ooter. ooter outerSlot. ooter outerMethod. inner. inner innerSlot. inner innerMethod. ooter Inner. ooter Sibling. inner InnerInner.}.

	(* Incremental method *)
	(in: builder instanceSide nestedClasses findMirrorNamed: #Inner) instanceSide methods addFromSource: 'public testMethod = (^{outer Outer. outerSlot. outerMethod. outer Inner. innerSlot. innerMethod. Inner. Sibling. InnerInner})'.
	builder install.
	assertList: inner testMethod equals: {ooter. ooter outerSlot. ooter outerMethod. inner. inner innerSlot. inner innerMethod. ooter Inner. ooter Sibling. inner InnerInner.}.

	(* Incremental header *)
	(in: builder instanceSide nestedClasses findMirrorNamed: #Inner) header source: 'public class Inner = ( | public innerSlot = 33. public testSlot = {outer Outer. outerSlot. outerMethod. outer Inner. innerSlot. innerMethod. Inner. Sibling. InnerInner}. |)'.
	builder install.
	inner:: ooter Inner new.
	assertList: inner testSlot equals: {ooter. ooter outerSlot. ooter outerMethod. inner. inner innerSlot. inner innerMethod. ooter Inner. ooter Sibling. inner InnerInner.}.

	(* Incremental nested class *)
	builder instanceSide nestedClasses addFromSource: 'public class Inner2 = ( | public innerSlot = 333. | )(
		public class InnerInner = ()()
		public innerMethod = (^444)
		public testMethod = (^{outer Outer. outerSlot. outerMethod. outer Inner2. innerSlot. innerMethod. Inner2. Sibling. InnerInner})
	)'.
	builder install.
	inner:: ooter Inner2 new.
	assertList: inner testMethod equals: {ooter. ooter outerSlot. ooter outerMethod. inner. inner innerSlot. inner innerMethod. ooter Inner2. ooter Sibling. inner InnerInner.}.
)
public testInstallAfterConflictErrorFactory = (
	| klass builder |
	klass:: classFromSource: 'class TestInstallAfterConflictErrorFactory factory = ()( public foo = (^1) )'.
	assert: klass factory foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder classSide methods addFromSource: 'public factory = (^#wrong)'] signal: conflictError.
	builder install.
	assert: klass factory foo equals: 1. (* Unchanged. *)
)
public testInstallAfterConflictErrorMethod = (
	| klass instance builder |
	klass:: classFromSource: 'class TestInstallAfterConflictErrorMethod = ()( public foo = (^1) )'.
	instance:: klass new.
	assert: instance foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder header source: 'TestInstallAfterConflictErrorMethod = (| foo |)'] signal: conflictError.
	builder install.
	assert: instance foo equals: 1. (* Unchanged. *)
)
public testInstallAfterConflictErrorNestedClass = (
	| klass instance builder |
	klass:: classFromSource: 'class TestInstallAfterConflictErrorNestedClass = ()(
		public class Nested = ()() : ( public foo = (^1) )
	)'.
	instance:: klass new.
	assert: instance Nested foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder instanceSide addFromSource: 'public Nested = (^#wrong)'] signal: conflictError.
	builder install.
	assert: instance Nested foo equals: 1. (* Unchanged. *)
)
public testInstallAfterConflictErrorSlot = (
	| klass instance builder |
	klass:: classFromSource: 'class TestInstallAfterConflictErrorSlot = (| public foo = 1. |)()'.
	instance:: klass new.
	assert: instance foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder header source: 'TestInstallAfterConflictErrorSlot = (| foo |)'] signal: conflictError.
	builder install.
	assert: instance foo equals: 1. (* Unchanged. *)
)
public testInstallAfterSyntaxErrorHeader = (
	| klass instance builder |
	klass:: classFromSource: 'class TestInstallAfterSyntaxErrorHeader = (| public foo = 1. |)()'.
	instance:: klass new.
	assert: instance foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder header source: 'class TestInstallAfterSyntaxErrorHeader = (;;syntax error;;)()'] signal: syntaxError.
	builder install.
	assert: instance foo equals: 1. (* Unchanged. *)
)
public testInstallAfterSyntaxErrorMethod = (
	| klass instance builder |
	klass:: classFromSource: 'class TestInstallAfterSyntaxErrorMethod = ()( public foo = (^1) )'.
	instance:: klass new.
	assert: instance foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder instanceSide methods addFromSource: 'public foo = (^2 ;;syntax error;;)'] signal: syntaxError.
	builder install.
	assert: instance foo equals: 1. (* Unchanged. *)
)
public testInstallAfterSyntaxErrorNestedClass = (
	| klass builder |
	klass:: classFromSource: 'class TestInstallAfterSyntaxErrorNestedClass = ()(
		public class Nested = ()() : ( public foo = (^1) )
	)'.
	assert: klass new Nested foo equals: 1.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	should: [builder instanceSide nestedClasses addFromSource: 'class Nested = (;;syntax error;;)()'] signal: syntaxError.
	builder install.
	assert: klass new Nested foo equals: 1. (* Unchanged. *)
)
public testMethodSource = (
	(* Note: We preserve exact class headers and methods, but not whole class declarations. *)
	|
	methodSource
	klass <Class>
	builder <ClassDeclarationBuilder>
	mirror <ClassMirror>
	|

	methodSource:: 'private foo = (
		^bar baz
	)'.

	builder:: ClassDeclarationBuilder fromSource: 'class C = ()(', methodSource, ')'.
	assert: (in: builder instanceSide methods findMirrorNamed: #foo) source equals: methodSource.

	klass:: builder install applyToObject reflectee.
	mirror:: ClassMirror reflecting: klass.
	assert: (in: mirror mixin methods findMirrorNamed: #foo) source equals: methodSource.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	assert: (in: builder instanceSide methods findMirrorNamed: #foo) source equals: methodSource.
)
public testNewNestedClassSeenInSubclass = (
	(* Note that the superclass and subclass must be part of separate modules. Otherwise this test will pass by virtue of the common enclosing class being dirty, and here we want to test that subclasses tracking is working. *)
	|
	Super <Class>
	enclosing <Class>
	klass <Class>
	instance <Object>
	builder <ClassDeclarationBuilder>
	|
	Super:: classFromSource: 'class Super = ()()'.
	enclosing:: classFromSource: 'class Enclosing withSuper: s = ( | Super = s. | )(
		public class Sub = Super ()(
			public class OldNested = ()()
		)
	)'.
	klass:: (enclosing withSuper: Super) Sub.
	instance:: klass new.
	assert: instance OldNested isKindOfBehavior.
	should: [instance NewNested] signal: MessageNotUnderstood.

	builder:: (ClassMirror reflecting: klass) superclass mixin declaration asBuilder.
	builder instanceSide nestedClasses addFromSource: 'public class NewNested = ()()'.

	assert: instance OldNested isKindOfBehavior.
	should: [instance NewNested] signal: MessageNotUnderstood.

	builder install.

	assert: instance OldNested isKindOfBehavior.
	assert: instance NewNested isKindOfBehavior.
	deny: instance OldNested equals: instance NewNested. (* Should not alias slot. *)

	instance:: klass new.
	assert: instance OldNested isKindOfBehavior.
	assert: instance NewNested isKindOfBehavior.
	deny: instance OldNested equals: instance NewNested. (* Should not alias slot. *)
)
public testNewSlotSeenInSubclass = (
	(* Note that the superclass and subclass must be part of separate modules. Otherwise this test will pass by virtue of the common enclosing class being dirty, and here we want to test that subclasses tracking is working. *)
	|
	Super <Class>
	enclosing <Class>
	klass <Class>
	instance <Object>
	builder <ClassDeclarationBuilder>
	|
	Super:: classFromSource: 'class Super = ()()'.
	enclosing:: classFromSource: 'class Enclosing withSuper: s = ( | Super = s. | )(
		public class Sub = Super ( | public oldSlot ::= 43. | )()
	)'.
	klass:: (enclosing withSuper: Super) Sub.
	instance:: klass new.
	assert: instance oldSlot equals: 43.
	should: [instance newSlot] signal: MessageNotUnderstood.

	builder:: (ClassMirror reflecting: klass) superclass mixin declaration asBuilder.
	builder header source: 'class Super = ( | public newSlot ::= 47. | )'.

	assert: instance oldSlot equals: 43.
	should: [instance newSlot] signal: MessageNotUnderstood.

	builder install.

	assert: instance oldSlot equals: 43.
	assert: instance newSlot equals: nil.
	instance newSlot: 98.
	assert: instance newSlot equals: 98.
	assert: instance oldSlot equals: 43. (* Not aliased by newSlot. *)

	instance:: klass new.
	assert: instance oldSlot equals: 43.
	assert: instance newSlot equals: 47.
)
public testShapeChangePreservesIdentityHash = (
	|
	klass <Class>
	instance <Object>
	oldHash <Integer>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class Foo = ()()'.
	instance:: klass new.
	oldHash:: instance hash.
	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class Foo = ( | public newSlot ::= 91. | )'.
	builder install.
	assert: instance newSlot equals: nil.
	assert: instance hash equals: oldHash.
)
public testShapeChangeWithHostileEquals = (
	|
	klass <Class>
	instance1 <Object>
	instance2 <Object>
	builder <ClassDeclarationBuilder>
	|
	klass:: classFromSource: 'class Class slot: s = ( | public slot = s. |)(
		public = other ^<Boolean> = ( ^Error signal: ''Should not be called'' )
		public hash ^<Integer> = ( ^Error signal: ''Should not be called'' )
	) : (
		public = other ^<Boolean> = ( ^Error signal: ''Should not be called'' )
		public hash ^<Integer> = ( ^Error signal: ''Should not be called'' )
	)'.
	instance1:: klass slot: 1.
	instance2:: klass slot: 2.
	assert: instance1 slot equals: 1.
	assert: instance2 slot equals: 2.

	builder:: (ClassMirror reflecting: klass) mixin declaration asBuilder.
	builder header source: 'class Class slot: s = ( | public slot = s. public newSlot |)'.
	builder install.
	instance1:: klass slot: 1.
	instance2:: klass slot: 2.
	assert: instance1 slot equals: 1.
	assert: instance2 slot equals: 2.
	assert: instance1 newSlot equals: nil.
	assert: instance2 newSlot equals: nil.
)
) : (
TEST_CONTEXT = ()
)
) : (
)