Chris Muller uploaded a new version of SystemChangeNotification-Tests to project Squeak 4.6:
http://source.squeak.org/squeak46/SystemChangeNotification-Tests-nice.23.mcz

==================== Summary ====================

Name: SystemChangeNotification-Tests-nice.23
Author: nice
Time: 18 December 2013, 2:43:23.729 pm
UUID: 3eed6d26-4aef-4095-a604-d9f914240281
Ancestors: SystemChangeNotification-Tests-fbs.22

Use non logging Compiler protocol rather than providing a logged: false argument.

==================== Snapshot ====================

SystemOrganization addCategory: #'SystemChangeNotification-Tests'!

TestCase subclass: #SystemChangeFileTest
	instanceVariableNames: 'tempChangesFile tempChangesName'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

----- Method: SystemChangeFileTest>>change:verify: (in category 'testing') -----
change: changeBlock verify: verifyBlock
	self prepare: [] change: changeBlock verify: verifyBlock!

----- Method: SystemChangeFileTest>>createClass: (in category 'private') -----
createClass: name
	^Object
		subclass: name
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: self genericClassCategory!

----- Method: SystemChangeFileTest>>directory (in category 'accessing') -----
directory
	"Where we want to place the temporary changes file"
	^FileDirectory default!

----- Method: SystemChangeFileTest>>expectedFailures (in category 'testing') -----
expectedFailures
	^#(
		#testCategoryModified
		#testClassReorganized
		#testProtocolModified
	)!

----- Method: SystemChangeFileTest>>genericChangesName (in category 'private') -----
genericChangesName
	^self prefixChangesName, self randomString, '.changes'!

----- Method: SystemChangeFileTest>>genericClassCategory (in category 'private') -----
genericClassCategory
	^(self prefixClassCategory, self randomString capitalized) asSymbol!

----- Method: SystemChangeFileTest>>genericClassName (in category 'private') -----
genericClassName
	^(self prefixClassName, self randomString capitalized) asSymbol!

----- Method: SystemChangeFileTest>>genericInstVarName (in category 'private') -----
genericInstVarName
	^(self prefixInstVarName, self randomString capitalized) asSymbol!

----- Method: SystemChangeFileTest>>genericProtocol (in category 'private') -----
genericProtocol
	^(self prefixProtocol, self randomString) asSymbol!

----- Method: SystemChangeFileTest>>genericSelector (in category 'private') -----
genericSelector
	^(self prefixSelector, self randomString capitalized) asSymbol!

----- Method: SystemChangeFileTest>>prefixChangesName (in category 'private') -----
prefixChangesName
	^self prefixGeneral!

----- Method: SystemChangeFileTest>>prefixClassCategory (in category 'private') -----
prefixClassCategory
	^self prefixGeneral, 'Category-'!

----- Method: SystemChangeFileTest>>prefixClassName (in category 'private') -----
prefixClassName
	^self prefixGeneral, 'Class'!

----- Method: SystemChangeFileTest>>prefixGeneral (in category 'private') -----
prefixGeneral
	^self class name select: [:each | each isUppercase]!

----- Method: SystemChangeFileTest>>prefixInstVarName (in category 'private') -----
prefixInstVarName
	^self prefixGeneral asLowercase, 'InstVar'!

----- Method: SystemChangeFileTest>>prefixProtocol (in category 'private') -----
prefixProtocol
	^self prefixGeneral asLowercase, ' protocol '!

----- Method: SystemChangeFileTest>>prefixSelector (in category 'private') -----
prefixSelector
	^self prefixGeneral asLowercase, 'Selector'!

----- Method: SystemChangeFileTest>>prepare:change:verify: (in category 'testing') -----
prepare: prepareBlock change: changeBlock verify: verifyBlock
	"All tests follow this pattern. Beware that prepareBlock (and verifyBlock) will be evalutated twice."
	
	"Setup the testcourt"
	prepareBlock value.
	
	"Embrace the changeBlock so that any change to our testcourt
	will be recorded in our temporary changes file"
	self useTemporaryChangesFile.
	changeBlock value.
	"Check if the changes we made worked as expected. We need to do
	this before we switch back to the standard changes file"
	"We raise an Error if this fails, because then the testcase is broken"
	[verifyBlock value]
		on: TestFailure
		do: [self error: 'The verifyBlock needs to validate the changes made in the changeBlock'].
	self useStandardChangesFile.

	"Remove the testcourt completely"
	self removeTestcourt.

	"Setup the testcourt once again"
	prepareBlock value.

	"Replay the changes from the temporary changes file"
	self replayChanges.

	"See if we got the same changes as we did before using the changeBlock"
	verifyBlock value.
!

----- Method: SystemChangeFileTest>>randomString (in category 'private') -----
randomString
	^Character alphabet shuffled!

----- Method: SystemChangeFileTest>>removeTestcourt (in category 'private') -----
removeTestcourt
	SystemOrganization categories do: [:each |
		(each beginsWith: self prefixClassCategory) ifTrue: [
			SystemOrganization removeSystemCategory: each.
		].
	].
		
!

----- Method: SystemChangeFileTest>>replayChanges (in category 'private') -----
replayChanges
	| file |
	file := FileStream fileNamed: (self directory fullNameFor: self tempChangesName).
	Transcript show: file contents; cr.
	file fileIn.
!

----- Method: SystemChangeFileTest>>tearDown (in category 'running') -----
tearDown
	self useStandardChangesFile.
	tempChangesFile := tempChangesFile ifNotNil: [tempChangesFile close].
	(self directory fileExists: self tempChangesName)
		ifTrue: [self directory deleteFileNamed: self tempChangesName].
	self removeTestcourt.
!

----- Method: SystemChangeFileTest>>tempChangesName (in category 'accessing') -----
tempChangesName
	^tempChangesName ifNil: [tempChangesName := self genericChangesName]!

----- Method: SystemChangeFileTest>>testCategoryAdded (in category 'testing') -----
testCategoryAdded
	| aClassCategory |
	aClassCategory := self genericClassCategory.
	self
		change: [
			SystemOrganization addCategory: aClassCategory.
		]
		verify: [
			self assert: (SystemOrganization categories includes: aClassCategory).
		]
!

----- Method: SystemChangeFileTest>>testCategoryAddedBefore (in category 'testing') -----
testCategoryAddedBefore
	| aClassCategory |
	aClassCategory := self genericClassCategory.
	self
		change: [
			SystemOrganization addCategory: aClassCategory before: nil.
		]
		verify: [
			self assert: (SystemOrganization categories includes: aClassCategory).
		]
!

----- Method: SystemChangeFileTest>>testCategoryModified (in category 'as yet unclassified') -----
testCategoryModified
	self assert: false description: 'When does that happen?'!

----- Method: SystemChangeFileTest>>testCategoryRemoved (in category 'testing') -----
testCategoryRemoved
	| aClassCategory |
	aClassCategory := self genericClassCategory.
	self
		prepare: [
			SystemOrganization addCategory: aClassCategory.
		]
		change: [
			SystemOrganization removeCategory: aClassCategory.
		]
		verify: [
			self deny: (SystemOrganization categories includes: aClassCategory).
		]
!

----- Method: SystemChangeFileTest>>testCategoryRenamed (in category 'testing') -----
testCategoryRenamed
	| aNewClassCategory anOldClassCategory |
	anOldClassCategory := self genericClassCategory.
	aNewClassCategory := self genericClassCategory.
	self
		prepare: [
			SystemOrganization addCategory: anOldClassCategory.
		]
		change: [
			SystemOrganization renameCategory: anOldClassCategory toBe: aNewClassCategory
		]
		verify: [
			self assert: (SystemOrganization categories includes: aNewClassCategory).
			self deny: (SystemOrganization categories includes: anOldClassCategory).
		]
!

----- Method: SystemChangeFileTest>>testClassAdded (in category 'testing') -----
testClassAdded
	| aClassName |
	aClassName := self genericClassName.
	self
		change: [
			self createClass: aClassName.
		]
		verify: [
			self assert: (Smalltalk globals includesKey: aClassName).
		]

!

----- Method: SystemChangeFileTest>>testClassCommented (in category 'testing') -----
testClassCommented
	| aClass aClassName aComment |
	aClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aComment := self randomString.
			aClass classComment: aComment.
		]
		verify: [
			self assert: aClass organization classComment string = aComment.
		].!

----- Method: SystemChangeFileTest>>testClassModified (in category 'testing') -----
testClassModified
	| aClass aClassName aInstVarName |
	aClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aInstVarName := self genericInstVarName.
			aClass addInstVarName: aInstVarName.
		]
		verify: [
			self assert: (aClass instVarNames includes: aInstVarName).
		].!

----- Method: SystemChangeFileTest>>testClassRecategorized (in category 'testing') -----
testClassRecategorized
	| aClassName aNewClassCategory |
	aClassName := self genericClassName.
	aNewClassCategory := self genericClassCategory.
	self
		prepare: [
			self createClass: aClassName.
			SystemOrganization addCategory: aNewClassCategory.
		]
		change: [
			SystemOrganization classify: aClassName under: aNewClassCategory.
		]
		verify: [
			self assert: (SystemOrganization categoryOfElement: aClassName) = aNewClassCategory.
		]
!

----- Method: SystemChangeFileTest>>testClassRemoved (in category 'testing') -----
testClassRemoved
	| aClass aClassName |
	aClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aClass removeFromSystem.
		]
		verify: [
			self deny: (Smalltalk globals includesKey: aClassName).
		].
!

----- Method: SystemChangeFileTest>>testClassRenamed (in category 'testing') -----
testClassRenamed
	| aClass aNewClassName anOldClassName |
	anOldClassName := self genericClassName.
	aNewClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: anOldClassName.
		]
		change: [
			aClass rename: aNewClassName.
		]
		verify: [
			self assert: (Smalltalk globals includesKey: aNewClassName).
			self deny: (Smalltalk globals includesKey: anOldClassName).
		].!

----- Method: SystemChangeFileTest>>testClassReorganized (in category 'as yet unclassified') -----
testClassReorganized
	self assert: false description: 'When does that happen?'!

----- Method: SystemChangeFileTest>>testExpressionDoIt (in category 'testing') -----
testExpressionDoIt
	| aClassName |
	aClassName := self genericClassName..
	self
		prepare: [
			self createClass: aClassName.
		]
		change: [
			Compiler evaluate: '(Smalltalk at: ', aClassName storeString, ') removeFromSystem'.
		]
		verify: [
			self deny: (Smalltalk globals includesKey: aClassName).
		].!

----- Method: SystemChangeFileTest>>testMethodAdded (in category 'testing') -----
testMethodAdded
	| aClassName aClass aSelector |
	aClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aSelector := self genericSelector.
			aClass compile: aSelector.
		]
		verify: [
			self assert: (aClass methodDict includesKey: aSelector).
		]

!

----- Method: SystemChangeFileTest>>testMethodModified (in category 'testing') -----
testMethodModified
	| aClassName aClass aSelector aMethodSource |
	aClassName := self genericClassName.
	aSelector := self genericSelector.
	self
		prepare: [
			aClass := self createClass: aClassName.
			aClass compile: aSelector, ' ', self randomString storeString.
		]
		change: [
			aMethodSource := aSelector, ' ', self randomString storeString.
			aClass compile: aMethodSource.
		]
		verify: [
			self assert: (aClass sourceCodeAt: aSelector) string = aMethodSource.
		]

!

----- Method: SystemChangeFileTest>>testMethodRecategorized (in category 'testing') -----
testMethodRecategorized
	| aClassName aClass aNewProtocol aSelector anOldProtocol |
	aClassName := self genericClassName.
	aSelector := self genericSelector.
	anOldProtocol := self genericProtocol.
	self
		prepare: [
			aClass := self createClass: aClassName.
			aClass compile: aSelector classified: anOldProtocol.
		]
		change: [
			aNewProtocol := self genericProtocol.
			aClass organization classify: aSelector under: aNewProtocol.
		]
		verify: [
			self assert: (aClass organization categoryOfElement: aSelector) = aNewProtocol
		]

!

----- Method: SystemChangeFileTest>>testMethodRemoved (in category 'testing') -----
testMethodRemoved
	| aClassName aClass aSelector |
	aClassName := self genericClassName.
	aSelector := self genericSelector.
	self
		prepare: [
			aClass := self createClass: aClassName.
			aClass compile: aSelector.
		]
		change: [
			aClass removeSelector: aSelector.
		]
		verify: [
			self deny: (aClass methodDict includesKey: aSelector).
		]

!

----- Method: SystemChangeFileTest>>testProtocolAdded (in category 'testing') -----
testProtocolAdded
	| aClassName aClass aProtocol |
	aClassName := self genericClassName.
	aProtocol := self genericProtocol.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aClass organization addCategory: aProtocol.
		]
		verify: [
			self assert: (aClass organization categories includes: aProtocol)
		]

!

----- Method: SystemChangeFileTest>>testProtocolDefault (in category 'testing') -----
testProtocolDefault
	| aClassName aClass aSelector |
	aClassName := self genericClassName.
	self
		prepare: [
			aClass := self createClass: aClassName.
		]
		change: [
			aSelector := self genericSelector.
			aClass compile: aSelector.
		]
		verify: [
			self assert: (aClass organization categoryOfElement: aSelector) = aClass organization class default.
		]

!

----- Method: SystemChangeFileTest>>testProtocolModified (in category 'as yet unclassified') -----
testProtocolModified
	self assert: false description: 'When does that happen?'!

----- Method: SystemChangeFileTest>>testProtocolRemoved (in category 'testing') -----
testProtocolRemoved
	| aClassName aClass aProtocol |
	aClassName := self genericClassName.
	aProtocol := self genericProtocol.
	self
		prepare: [
			aClass := self createClass: aClassName.
			aClass organization addCategory: aProtocol.
		]
		change: [
			aClass organization removeCategory: aProtocol.
		]
		verify: [
			self deny: (aClass organization categories includes: aProtocol)
		]

!

----- Method: SystemChangeFileTest>>testProtocolRenamed (in category 'testing') -----
testProtocolRenamed
	| aClassName aClass anOldProtocol aNewProtocol |
	aClassName := self genericClassName.
	anOldProtocol := self genericProtocol.
	self
		prepare: [
			aClass := self createClass: aClassName.
			aClass organization addCategory: anOldProtocol.
		]
		change: [
			aNewProtocol := self genericProtocol.
			aClass organization renameCategory: anOldProtocol toBe: aNewProtocol.
		]
		verify: [
			self deny: (aClass organization categories includes: anOldProtocol).
			self assert: (aClass organization categories includes: aNewProtocol).
		]

!

----- Method: SystemChangeFileTest>>useStandardChangesFile (in category 'private') -----
useStandardChangesFile
	Smalltalk
		closeSourceFiles;
		openSourceFiles!

----- Method: SystemChangeFileTest>>useTemporaryChangesFile (in category 'private') -----
useTemporaryChangesFile
	Smalltalk closeSourceFiles.
	tempChangesFile := self directory forceNewFileNamed: self tempChangesName.
	SourceFiles at: 2 put: tempChangesFile!

TestCase subclass: #SystemChangeTestRoot
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

!SystemChangeTestRoot commentStamp: 'rw 4/5/2006 17:28' prior: 0!
The Root test class for the System Change Notification tests.!

SystemChangeTestRoot subclass: #ChangeHooksTest
	instanceVariableNames: 'previousChangeSet testsChangeSet capturedEvents generatedTestClass generatedTestClassX createdMethodName createdMethod doItExpression'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

!ChangeHooksTest commentStamp: 'bp 12/4/2009 10:37' prior: 0!
This class implements unit tests to verify that when the system changes, notification messages are sent around correctly.

Therefore the test messages make a system change, after registering to receive an event after the change occured. In this event (sent immediately after the change), the actual assertions take place.

Note that the system changes are *really* made to the system, but in a change set that is created in the setUp method, while the previous one is restored in the tearDown method.!

----- Method: ChangeHooksTest>>addSingleEvent: (in category 'Private') -----
addSingleEvent: anEvent

	capturedEvents isEmpty ifFalse: [self assert: false].
	capturedEvents add: anEvent!

----- Method: ChangeHooksTest>>checkEvent:kind:item:itemKind: (in category 'Private') -----
checkEvent: anEvent kind: changeKind item: item itemKind: itemKind 

	self assert: (anEvent perform: ('is' , changeKind) asSymbol).
	self assert: anEvent item = item.
	self assert: anEvent itemKind = itemKind!

----- Method: ChangeHooksTest>>checkForOnlySingleEvent (in category 'Private') -----
checkForOnlySingleEvent

	self assert: capturedEvents size = 1!

----- Method: ChangeHooksTest>>classCommentedEvent: (in category 'Events-Classes') -----
classCommentedEvent: event 

	self addSingleEvent: event.
	self assert: generatedTestClass comment = self commentStringForTesting.
	self 
		checkEvent: event
		kind: #Commented
		item: generatedTestClass
		itemKind: AbstractEvent classKind!

----- Method: ChangeHooksTest>>classCreationEvent: (in category 'Events-Classes') -----
classCreationEvent: event 

	| classCreated |
	self addSingleEvent: event.
	classCreated := Smalltalk classNamed: self newlyCreatedClassName.
	self assert: classCreated notNil.
	self 
		assert: ((Smalltalk organization 
				listAtCategoryNamed: #'System-Change Notification') 
					includes: self newlyCreatedClassName).
	self 
		checkEvent: event
		kind: #Added
		item: classCreated
		itemKind: AbstractEvent classKind!

----- Method: ChangeHooksTest>>classRecategorizedEvent: (in category 'Events-Classes') -----
classRecategorizedEvent: event 

	self addSingleEvent: event.
	self 
		checkEvent: event
		kind: #Recategorized
		item: generatedTestClass
		itemKind: AbstractEvent classKind.
	self assert: event oldCategory = #'System-Change Notification'!

----- Method: ChangeHooksTest>>classRedefinitionEvent: (in category 'Events-Classes') -----
classRedefinitionEvent: event 
	
	self addSingleEvent: event.
	self 
		checkEvent: event
		kind: #Modified
		item: generatedTestClass
		itemKind: AbstractEvent classKind.!

----- Method: ChangeHooksTest>>classRemovalEvent: (in category 'Events-Classes') -----
classRemovalEvent: event 
	"This event used to be sent efter the class was removed.
	This was changed, and therefore this test is useless currently."

	self addSingleEvent: event.
	self assert: (Smalltalk classNamed: self generatedTestClassName) isNil.
	self 
		checkEvent: event
		kind: #Removed
		item: self generatedTestClassName
		itemKind: AbstractEvent classKind!

----- Method: ChangeHooksTest>>classRenameEvent: (in category 'Events-Classes') -----
classRenameEvent: event 

	| renamedClass |
	self addSingleEvent: event.
	renamedClass := Smalltalk classNamed: self renamedTestClassName.
	self assert: renamedClass notNil.
	self assert: (Smalltalk classNamed: self generatedTestClassName) isNil.
	self 
		checkEvent: event
		kind: #Renamed
		item: renamedClass
		itemKind: AbstractEvent classKind.
	self assert: event oldName = self generatedTestClassName!

----- Method: ChangeHooksTest>>classSuperChangedEvent: (in category 'Events-Classes') -----
classSuperChangedEvent: event 

	self addSingleEvent: event.
	self 
		checkEvent: event
		kind: #Modified
		item: generatedTestClass
		itemKind: AbstractEvent classKind.
	self assert: generatedTestClass superclass = Model!

----- Method: ChangeHooksTest>>commentStringForTesting (in category 'Private') -----
commentStringForTesting

	^'Added this comment as part of the unit test in SystemChangeTest>>testClassCommentedBasicEvents. You should never see this, unless you are debugging the system somewhere in between the tests.'!

----- Method: ChangeHooksTest>>generateTestClass (in category 'Private-Generation') -----
generateTestClass

	generatedTestClass := Object
				subclass: self generatedTestClassName
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: 'System-Change Notification'.!

----- Method: ChangeHooksTest>>generateTestClassX (in category 'Private-Generation') -----
generateTestClassX

	generatedTestClassX := Object
				subclass: self generatedTestClassNameX
				instanceVariableNames: 'x'
				classVariableNames: ''
				poolDictionaries: ''
				category: 'System-Change Notification'.!

----- Method: ChangeHooksTest>>generatedTestClassName (in category 'Private-Generation') -----
generatedTestClassName


	^#'AutoGeneratedClassForTestingSystemChanges'!

----- Method: ChangeHooksTest>>generatedTestClassNameX (in category 'Private-Generation') -----
generatedTestClassNameX

	^#'AutoGeneratedClassXForTestingSystemChanges'!

----- Method: ChangeHooksTest>>instanceVariableCreationEvent: (in category 'Events-Instance Variables') -----
instanceVariableCreationEvent: event

	self addSingleEvent: event.	
	self assert: event isModified.
	self assert: event item = generatedTestClass.
	self assert: event itemKind = AbstractEvent classKind.
	self assert: event areInstVarsModified.
	self deny: event isSuperclassModified.
	self deny: event areClassVarsModified.
	self deny: event areSharedPoolsModified.
	
!

----- Method: ChangeHooksTest>>instanceVariableRemovedEvent: (in category 'Events-Instance Variables') -----
instanceVariableRemovedEvent: event

	self addSingleEvent: event.	
	self assert: event isModified.
	self assert: event item = generatedTestClassX.
	self assert: event itemKind = AbstractEvent classKind.
	self assert: event areInstVarsModified.
	self deny: event isSuperclassModified.
	self deny: event areClassVarsModified.
	self deny: event areSharedPoolsModified.
	
!

----- Method: ChangeHooksTest>>methodCreationEvent1: (in category 'Events-Methods') -----
methodCreationEvent1: event 

	| methodCreated |
	self addSingleEvent: event.
	methodCreated := generatedTestClass >> createdMethodName.
	self 
		checkEvent: event
		kind: #Added
		item: methodCreated
		itemKind: AbstractEvent methodKind!

----- Method: ChangeHooksTest>>methodCreationEvent2: (in category 'Events-Methods') -----
methodCreationEvent2: event 

	| methodCreated |
	self addSingleEvent: event.
	methodCreated := generatedTestClass >> createdMethodName.
	self 
		checkEvent: event
		kind: #Added
		item: methodCreated
		itemKind: AbstractEvent methodKind!

----- Method: ChangeHooksTest>>methodDoItEvent1: (in category 'Events-Expression') -----
methodDoItEvent1: event 

	self addSingleEvent: event.
	self 
		checkEvent: event
		kind: #DoIt
		item: doItExpression
		itemKind: AbstractEvent expressionKind.
	self assert: event context isNil.!

----- Method: ChangeHooksTest>>methodRecategorizationEvent: (in category 'Events-Methods') -----
methodRecategorizationEvent: event

	| methodCreated |
	self addSingleEvent: event.
	methodCreated := generatedTestClass >> createdMethodName.
	self assert: ((generatedTestClass organization categoryOfElement: createdMethodName) = #newCategory).
	self assert: event oldCategory = #testing.
	self 
		checkEvent: event
		kind: #Recategorized
		item: methodCreated
		itemKind: AbstractEvent methodKind.!

----- Method: ChangeHooksTest>>methodRemovedEvent1: (in category 'Events-Methods') -----
methodRemovedEvent1: event 

	self addSingleEvent: event.
	self should: [generatedTestClass >> createdMethodName] raise: Error.
	self 
		checkEvent: event
		kind: #Removed
		item: createdMethod
		itemKind: AbstractEvent methodKind.
	event itemClass = generatedTestClass.
	event itemMethod = createdMethodName.
	self assert: ((generatedTestClass organization categoryOfElement: createdMethodName) isNil).!

----- Method: ChangeHooksTest>>methodRemovedEvent2: (in category 'Events-Methods') -----
methodRemovedEvent2: event 

	self methodRemovedEvent1: event!

----- Method: ChangeHooksTest>>newlyCreatedClassName (in category 'Private-Generation') -----
newlyCreatedClassName

	^#'AutoGeneratedClassWhileTestingSystemChanges'!

----- Method: ChangeHooksTest>>rememberEvent: (in category 'Events-General') -----
rememberEvent: event

	capturedEvents add: event!

----- Method: ChangeHooksTest>>removeGeneratedTestClasses (in category 'Private') -----
removeGeneratedTestClasses
	"Remove all classes that were possibly generated during testing."
	
	| possiblyToRemove |
	possiblyToRemove := OrderedCollection
		with: self generatedTestClassName
		with: self generatedTestClassNameX
		with: self renamedTestClassName
		with: self newlyCreatedClassName.
	possiblyToRemove do: [:name | (Smalltalk hasClassNamed: name) ifTrue: [(Smalltalk at: name) removeFromSystemUnlogged]].
	generatedTestClass := nil.
	generatedTestClassX := nil!

----- Method: ChangeHooksTest>>renamedTestClassName (in category 'Private-Generation') -----
renamedTestClassName


	^#'AutoRenamedClassForTestingSystemChanges'!

----- Method: ChangeHooksTest>>setUp (in category 'Running') -----
setUp

	previousChangeSet := ChangeSet current.
	testsChangeSet := ChangeSet new.
	ChangeSet newChanges: testsChangeSet.
	capturedEvents := OrderedCollection new.
	self generateTestClass.
	self generateTestClassX.
	super setUp!

----- Method: ChangeHooksTest>>shouldNotBeCalledEvent: (in category 'Events-General') -----
shouldNotBeCalledEvent: anEvent
	"This event should not be called, so fail the test."

	self assert: false!

----- Method: ChangeHooksTest>>tearDown (in category 'Running') -----
tearDown

	self removeGeneratedTestClasses.
	ChangeSet newChanges: previousChangeSet.
	ChangesOrganizer removeChangeSet: testsChangeSet.
	previousChangeSet := nil.
	testsChangeSet := nil.
	capturedEvents := nil.
	createdMethod := nil.
	super tearDown!

----- Method: ChangeHooksTest>>testClassCommentedEvent (in category 'Testing-Classes') -----
testClassCommentedEvent

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classCommentedEvent:.
	generatedTestClass comment: self commentStringForTesting.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testClassCreationEvent (in category 'Testing-Classes') -----
testClassCreationEvent

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classCreationEvent:.
	Object 
		subclass: self newlyCreatedClassName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'System-Change Notification'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testClassRecategorizedEvent1 (in category 'Testing-Classes') -----
testClassRecategorizedEvent1

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classRecategorizedEvent:.
	Object 
		subclass: generatedTestClass name
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Collections-Abstract'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testClassRecategorizedEvent2 (in category 'Testing-Classes') -----
testClassRecategorizedEvent2

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classRecategorizedEvent:.
	generatedTestClass category: 'Collections-Abstract'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testClassRedefinition (in category 'Testing-Classes') -----
testClassRedefinition

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classRedefinitionEvent:.
	self generateTestClass!

----- Method: ChangeHooksTest>>testClassRemovalEvent (in category 'Testing-Classes') -----
testClassRemovalEvent
	"This event used to be sent efter the class was removed.
	This was changed, and therefore this test is useless currently."
	
	"Keep it, since I really want to check with the responsible for the ChangeSet,
	and it is very likely this will be reintroduced afterwards!!"

"	| createdClass |
	createdClass := self compileUniqueClass.
	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classRemovalEvent:.
	createdClass removeFromSystem.
	self checkForOnlySingleEvent
	
	"!

----- Method: ChangeHooksTest>>testClassRenamedEvent (in category 'Testing-Classes') -----
testClassRenamedEvent

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classRenameEvent:.
	generatedTestClass rename: self renamedTestClassName.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testClassSuperChangedEvent (in category 'Testing-Classes') -----
testClassSuperChangedEvent

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #classSuperChangedEvent:.
	Model 
		subclass: generatedTestClass name
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'System-Change Notification'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testDoItEvent1 (in category 'Testing-Expression') -----
testDoItEvent1

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodDoItEvent1:.
	doItExpression := '1 + 2'.
	Compiler evaluate: doItExpression logged: true.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testDoItEvent2 (in category 'Testing-Expression') -----
testDoItEvent2

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #shouldNotBeCalledEvent:.
	doItExpression := '1 + 2'.
	Compiler evaluate: doItExpression!

----- Method: ChangeHooksTest>>testInstanceVariableCreationEvent1 (in category 'Testing-Instance Variables') -----
testInstanceVariableCreationEvent1

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #instanceVariableCreationEvent:.
	Object 
		subclass: self generatedTestClassName
		instanceVariableNames: 'x'
		classVariableNames: ''
		poolDictionaries: ''
		category: 'System-Change Notification'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testInstanceVariableCreationEvent2 (in category 'Testing-Instance Variables') -----
testInstanceVariableCreationEvent2

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #instanceVariableCreationEvent:.
	generatedTestClass addInstVarName: 'x'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testInstanceVariableRemovedEvent1 (in category 'Testing-Instance Variables') -----
testInstanceVariableRemovedEvent1

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #instanceVariableRemovedEvent:.
	Object 
		subclass: generatedTestClassX name
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'System-Change Notification'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testInstanceVariableRemovedEvent2 (in category 'Testing-Instance Variables') -----
testInstanceVariableRemovedEvent2

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #instanceVariableRemovedEvent:.
	generatedTestClassX removeInstVarName: 'x'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testInstanceVariableRenamedSilently (in category 'Testing-Instance Variables') -----
testInstanceVariableRenamedSilently

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #shouldNotBeCalledEvent:.
	generatedTestClassX renameSilentlyInstVar: 'x' to: 'y'!

----- Method: ChangeHooksTest>>testMethodCreationEvent1 (in category 'Testing-Methods') -----
testMethodCreationEvent1

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodCreationEvent1:.
	createdMethodName := #testCreation.
	generatedTestClass compile: createdMethodName , '	^1'.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testMethodCreationEvent2 (in category 'Testing-Methods') -----
testMethodCreationEvent2

	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodCreationEvent2:.
	createdMethodName := #testCreation.
	generatedTestClass compile: createdMethodName , '	^1' classified: #testing.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testMethodRecategorizationEvent (in category 'Testing-Methods') -----
testMethodRecategorizationEvent

	createdMethodName := #testCreation.
	generatedTestClass compile: createdMethodName , '	^1' classified: #testing.
	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodRecategorizationEvent:.
	generatedTestClass organization 
		classify: createdMethodName
		under: #newCategory
		suppressIfDefault: false.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testMethodRemovedEvent1 (in category 'Testing-Methods') -----
testMethodRemovedEvent1

	createdMethodName := #testCreation.
	generatedTestClass compile: createdMethodName , '	^1'.
	createdMethod := generatedTestClass >> createdMethodName.
	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodRemovedEvent1:.
	generatedTestClass removeSelector: createdMethodName.
	self checkForOnlySingleEvent!

----- Method: ChangeHooksTest>>testMethodRemovedEvent2 (in category 'Testing-Methods') -----
testMethodRemovedEvent2

	createdMethodName := #testCreation.
	generatedTestClass compile: createdMethodName , '	^1'.
	createdMethod := generatedTestClass >> createdMethodName.
	self systemChangeNotifier notify: self
		ofAllSystemChangesUsing: #methodRemovedEvent2:.
	Smalltalk 
		removeSelector: (Array with: generatedTestClass name with: createdMethodName).
	self checkForOnlySingleEvent!

SystemChangeTestRoot subclass: #SystemChangeErrorHandling
	instanceVariableNames: 'capturedEvents'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

!SystemChangeErrorHandling commentStamp: 'bp 12/4/2009 10:37' prior: 0!
This class tests the error handing of the notification mechanism to ensure that one client that receives a system change cannot lock up the complete system.!

----- Method: SystemChangeErrorHandling>>handleEventWithError: (in category 'Event Notifications') -----
handleEventWithError: event

	self error: 'Example of event handling code that throws an error.'!

----- Method: SystemChangeErrorHandling>>handleEventWithHalt: (in category 'Event Notifications') -----
handleEventWithHalt: event

	self halt: 'Example of event handling code that contains a halt.'!

----- Method: SystemChangeErrorHandling>>setUp (in category 'Running') -----
setUp

	super setUp.
	capturedEvents := OrderedCollection new!

----- Method: SystemChangeErrorHandling>>storeEvent1: (in category 'Event Notifications') -----
storeEvent1: anEvent

	capturedEvents add: anEvent!

----- Method: SystemChangeErrorHandling>>storeEvent2: (in category 'Event Notifications') -----
storeEvent2: anEvent

	capturedEvents add: anEvent!

----- Method: SystemChangeErrorHandling>>storeEvent3: (in category 'Event Notifications') -----
storeEvent3: anEvent

	capturedEvents add: anEvent!

----- Method: SystemChangeErrorHandling>>tearDown (in category 'Running') -----
tearDown

	capturedEvents := nil.
	super tearDown!

----- Method: SystemChangeErrorHandling>>testErrorOperation (in category 'Testing') -----
testErrorOperation

	| notifier wasCaptured |
	notifier := self systemChangeNotifier.
	wasCaptured := false.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent1:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent2:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #handleEventWithError:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent3:.
	[notifier classAdded: self class inCategory: #FooCat] on: Error do: [:exc |
		wasCaptured := true.
		self assert: (capturedEvents size = 3)].
	self assert: wasCaptured.!

----- Method: SystemChangeErrorHandling>>testHaltOperation (in category 'Testing') -----
testHaltOperation
	
	| notifier wasCaptured |
	notifier := self systemChangeNotifier.
	wasCaptured := false.
	notifier notify: self ofAllSystemChangesUsing: #storeEvent1:.
	notifier notify: self ofAllSystemChangesUsing: #storeEvent2:.
	notifier notify: self ofAllSystemChangesUsing: #handleEventWithHalt:.
	notifier notify: self ofAllSystemChangesUsing: #storeEvent3:.
	[notifier classAdded: self class inCategory: #FooCat] on: Halt do: [:exc |
		wasCaptured := true.
		self assert: (capturedEvents size = 3)].
	self assert: wasCaptured.!

----- Method: SystemChangeErrorHandling>>testUnhandledEventOperation (in category 'Testing') -----
testUnhandledEventOperation

	| notifier wasCaptured |
	notifier := self systemChangeNotifier.
	wasCaptured := false.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent1:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent2:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #zork:.
	notifier notify: self ofSystemChangesOfItem: #class change: #Added using: #storeEvent3:.
	[notifier classAdded: self class inCategory: #FooCat] on: MessageNotUnderstood do: [:exc |
		wasCaptured := true.
		self assert: (capturedEvents size = 3)].
	self assert: wasCaptured.!

SystemChangeTestRoot subclass: #SystemChangeErrorHandlingTest
	instanceVariableNames: 'capturedEvents'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

SystemChangeTestRoot subclass: #SystemChangeNotifierTest
	instanceVariableNames: 'capturedEvent notifier'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SystemChangeNotification-Tests'!

!SystemChangeNotifierTest commentStamp: 'rw 4/3/2006 17:19' prior: 0!
A SystemChangeNotifierTest is a test class that tests whether the triggering of changes indeed results in the intended changes to be sent to registered object. The basic mechanism for each test is fairly simple:
	- register the receiver as the one to get the change notifier.
	- manually trigger a change (so the system is not polluted just to see whether we get the needed event).
	- the method #event: is invoked and remembers the change event.
	- the change event is checked to see whether it was the intended one.

Instance Variables
	capturedEvent:		Remembers the captured event!

----- Method: SystemChangeNotifierTest>>capturedEvent: (in category 'Private') -----
capturedEvent: eventOrNil
	"Remember the event being sent."

	capturedEvent := eventOrNil!

----- Method: SystemChangeNotifierTest>>checkEventForClass:category:change: (in category 'Private') -----
checkEventForClass: aClass category: cat change: changeKind 

	self assert: (capturedEvent perform: ('is' , changeKind) asSymbol).
	self assert: capturedEvent item = aClass.
	self assert: capturedEvent itemKind = AbstractEvent classKind.
	self assert: capturedEvent itemClass = aClass.
	self assert: capturedEvent itemCategory = cat!

----- Method: SystemChangeNotifierTest>>checkEventForMethod:protocol:change: (in category 'Private') -----
checkEventForMethod: aMethod protocol: prot change: changeKind 

	self assert: (capturedEvent perform: ('is' , changeKind) asSymbol).
	self assert: capturedEvent item = aMethod.
	self assert: capturedEvent itemKind = AbstractEvent methodKind.
	self assert: capturedEvent itemClass = self class.
	self assert: capturedEvent itemMethod = aMethod.
	self assert: capturedEvent itemProtocol = prot!

----- Method: SystemChangeNotifierTest>>checkEventForMethod:protocol:change:oldMethod: (in category 'Private') -----
checkEventForMethod: aMethod protocol: prot change: changeKind oldMethod: oldMethod

	self checkEventForMethod: aMethod protocol: prot change: changeKind.
	self assert: capturedEvent oldItem == oldMethod
	!

----- Method: SystemChangeNotifierTest>>event: (in category 'Event Notifications') -----
event: event
	"The notification message being sent to me when an event is captured. Remember it."

"	capturedEvent isNil ifTrue: [	self capturedEvent: event] ifFalse: [self assert: false]"

	self capturedEvent: event!

----- Method: SystemChangeNotifierTest>>setUp (in category 'Running') -----
setUp

	super setUp.
	notifier := SystemChangeNotifier createInstance.!

----- Method: SystemChangeNotifierTest>>systemChangeNotifier (in category 'Private') -----
systemChangeNotifier
	"The notifier to use. Do not use the one in the system so that the fake events triggered in the tests perturb clients of the system's change notifier (e.g. the changes file then shows fake entries)."

	^notifier!

----- Method: SystemChangeNotifierTest>>tearDown (in category 'Running') -----
tearDown

	super tearDown.
	self capturedEvent: nil.
	notifier releaseAll.
	notifier := nil!

----- Method: SystemChangeNotifierTest>>testClassAddedEvent (in category 'Testing-system triggers') -----
testClassAddedEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier classAdded: self class inCategory: #FooCat.
	self
		checkEventForClass: self class
		category: #FooCat
		change: #Added!

----- Method: SystemChangeNotifierTest>>testClassAddedEvent2 (in category 'Testing-system triggers') -----
testClassAddedEvent2

	self systemChangeNotifier notify: self ofSystemChangesOfItem: #class change: #Added using: #event:.
	self systemChangeNotifier classAdded: self class inCategory: #FooCat.
	self
		checkEventForClass: self class
		category: #FooCat
		change: #Added!

----- Method: SystemChangeNotifierTest>>testClassCommentedEvent (in category 'Testing-system triggers') -----
testClassCommentedEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier classCommented: self class inCategory: #FooCat.
	self
		checkEventForClass: self class
		category: #FooCat
		change: #Commented!

----- Method: SystemChangeNotifierTest>>testClassRecategorizedEvent (in category 'Testing-system triggers') -----
testClassRecategorizedEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		class: self class
		recategorizedFrom: #FooCat
		to: #FooBar.
	self
		checkEventForClass: self class
		category: #FooBar
		change: #Recategorized.
	self assert: capturedEvent oldCategory = #FooCat!

----- Method: SystemChangeNotifierTest>>testClassRemovedEvent (in category 'Testing-system triggers') -----
testClassRemovedEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier classRemoved: self class fromCategory: #FooCat.
	self
		checkEventForClass: self class
		category: #FooCat
		change: #Removed!

----- Method: SystemChangeNotifierTest>>testClassRenamedEvent (in category 'Testing-system triggers') -----
testClassRenamedEvent
	"self run: #testClassRenamedEvent"

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		classRenamed: self class
		from: #OldFooClass
		to: #NewFooClass
		inCategory: #FooCat.
	self
		checkEventForClass: self class
		category: #FooCat
		change: #Renamed.
"	self assert: capturedEvent oldName = #OldFooClass.
	self assert: capturedEvent newName = #NewFooClass"!

----- Method: SystemChangeNotifierTest>>testDoItEvent (in category 'Testing-system triggers') -----
testDoItEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		evaluated: '1 + 2'
		context: self.
	self assert: capturedEvent isDoIt.
	self assert: capturedEvent item = '1 + 2'.
	self assert: capturedEvent itemKind = AbstractEvent expressionKind.
	self assert: capturedEvent itemClass = nil.
	self assert: capturedEvent itemMethod = nil.
	self assert: capturedEvent itemProtocol = nil.
	self assert: capturedEvent itemExpression = '1 + 2'.
	self assert: capturedEvent context = self.!

----- Method: SystemChangeNotifierTest>>testMethodAddedEvent1 (in category 'Testing-system triggers') -----
testMethodAddedEvent1

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		methodAdded: self class >> #testMethodAddedEvent1
		selector: #testMethodAddedEvent1
		inProtocol: #FooCat
		class: self class.
	self 
		checkEventForMethod: self class >> #testMethodAddedEvent1
		protocol: #FooCat
		change: #Added!

----- Method: SystemChangeNotifierTest>>testMethodAddedEvent2 (in category 'Testing-system triggers') -----
testMethodAddedEvent2

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		methodAdded: self class >> #testMethodAddedEvent1
		selector: #testMethodAddedEvent1
		inClass: self class.
	self 
		checkEventForMethod: self class >> #testMethodAddedEvent1
		protocol: nil
		change: #Added!

----- Method: SystemChangeNotifierTest>>testMethodAddedEvent3 (in category 'Testing-system triggers') -----
testMethodAddedEvent3

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		methodChangedFrom: self class >> #testMethodAddedEvent1
		to: self class >> #testMethodAddedEvent2
		selector: #testMethodAddedEvent2
		inClass: self class.
	self 
		checkEventForMethod: self class >> #testMethodAddedEvent2
		protocol: nil
		change: #Modified
		oldMethod: self class >> #testMethodAddedEvent1.!

----- Method: SystemChangeNotifierTest>>testMethodRemovedEvent (in category 'Testing-system triggers') -----
testMethodRemovedEvent

	self systemChangeNotifier notify: self ofAllSystemChangesUsing: #event:.
	self systemChangeNotifier 
		methodRemoved: self class>> #testMethodRemovedEvent
		selector: #testMethodRemovedEvent
		inProtocol: #FooCat
		class: self class.
	self
		checkEventForMethod: self class>> #testMethodRemovedEvent
		protocol: #FooCat
		change: #Removed.!

----- Method: SystemChangeTestRoot>>systemChangeNotifier (in category 'Private') -----
systemChangeNotifier
	"The notifier to use. Use the one for the system."

	^SystemChangeNotifier uniqueInstance!

----- Method: SystemChangeTestRoot>>tearDown (in category 'Running') -----
tearDown

	self unhook.
	super tearDown!

----- Method: SystemChangeTestRoot>>unhook (in category 'Running') -----
unhook

	self systemChangeNotifier noMoreNotificationsFor: self!