Smalltalk › Squeak › Squeak - Dev

Squeak 4.6: SystemChangeNotification-Tests-nice.23.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

Squeak 4.6: SystemChangeNotification-Tests-nice.23.mcz

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!