Object subclass: #ConflictFinder instanceVariableNames: 'environment ownership definitions conflicts logFile' classVariableNames: '' poolDictionaries: '' category: 'ConflictFinder'! !ConflictFinder commentStamp: '' prior: 0! ConflictFinder is a utility to detect conflicts between packages, change sets, updates etc. It is intended to run as an automated tool which generating a report about the conflict between packages it finds. Usage: ConflictFinder findConflictsIn:{ 'FooPackage' -> [(FileStream readOnlyFileNamed: 'Foo.st') fileIn]. 'MantisFix1234' -> [Installer mantis ensureFix: 1234]. 'Mumble' -> [MczInstaller installFileNamed: 'Mumble-xyz.123.mcz']. }. ! !ConflictFinder methodsFor: 'initialize' stamp: 'ar 12/16/2008 21:03'! initialize "Initialize the receiver" environment := Smalltalk. definitions := Dictionary new. ownership := Dictionary new. conflicts := OrderedCollection new. logFile := Transcript.! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 20:36'! conflicts "Result. The collection holding the conflict information" ^conflicts! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 20:36'! conflicts: aCollection "Result. The collection holding the conflict information" conflicts := aCollection.! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 21:04'! environment "The environment to use when determining conflicts. Can be used to clamp down on the search space such as for the unit tests. Could also be used to find conflicts in particular sections of the system (Morphic for example)" ^environment! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 21:04'! environment: aDictionary "The environment to use when determining conflicts. Can be used to clamp down on the search space such as for the unit tests. Could also be used to find conflicts in particular sections of the system (Morphic for example)" environment := aDictionary.! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 20:35'! logFile "The log file to report intermediate results to." ^logFile! ! !ConflictFinder methodsFor: 'accessing' stamp: 'ar 12/16/2008 20:35'! logFile: aStream "The log file to report intermediate results to." logFile := aStream! ! !ConflictFinder methodsFor: 'running' stamp: 'ar 12/16/2008 21:46'! findConflictsIn: anArrayOfAssociations "The main API for conflict finder. Takes an array of name -> action and computes the conflicts after executing each action. Use like here: ConflictFinder findConflictsIn:{ 'FooPackage' -> [(FileStream readOnlyFileNamed: 'Foo.st') fileIn]. 'MantisFix1234' -> [Installer mantis ensureFix: 1234]. 'Mumble' -> [MczInstaller installFileNamed: 'Mumble-xyz.123.mcz']. }. " 'Finding conflicts' displayProgressAt: Sensor cursorPoint from: 0.0 to: 1.0 during:[:bar| ^self findConflictsIn: anArrayOfAssociations notifying: bar. ]. ! ! !ConflictFinder methodsFor: 'running' stamp: 'ar 12/16/2008 21:47'! findConflictsIn: anArrayOfAssociations notifying: progress "The main API for conflict finder. Takes an array of name -> action and computes the conflicts after executing each action. Use like here: ConflictFinder findConflictsIn:{ 'FooPackage' -> [(FileStream readOnlyFileNamed: 'Foo.st') fileIn]. 'MantisFix1234' -> [Installer mantis ensureFix: 1234]. 'Mumble' -> [MczInstaller installFileNamed: 'Mumble-xyz.123.mcz']. }. " | patchName patchAction assoc | logFile ifNotNil:[logFile cr; nextPutAll: 'Analysing base system ... '; flush]. progress ifNil:[ self updateConflicts: '' notifying: nil. "Base system" ] ifNotNil:[ ('Analysing base system') displayProgressAt: Sensor cursorPoint from: 0.0 to: 1.0 during:[:innerBar| self updateConflicts: '' notifying: innerBar. ]. ]. logFile ifNotNil:[logFile nextPutAll: ' done.'; flush]. 1 to: anArrayOfAssociations size do:[:i| assoc := anArrayOfAssociations at: i. patchName := assoc key. patchAction := assoc value. logFile ifNotNil:[logFile cr; nextPutAll: 'Loading ', patchName, ' ... '; flush]. patchAction value. "run it" logFile ifNotNil:[logFile nextPutAll: 'done.'; flush]. progress ifNil:[ self updateConflicts: patchName notifying: nil. "find conflicts" ] ifNotNil:[ ('Finding conflicts for: ', patchName) displayProgressAt: Sensor cursorPoint from: 0.0 to: 1.0 during:[:innerBar| self updateConflicts: patchName notifying: innerBar. ]. ]. ]. logFile ifNotNil:[logFile cr; nextPutAll: 'Analysis complete.'; flush]. ^conflicts! ! !ConflictFinder methodsFor: 'running' stamp: 'ar 12/16/2008 21:47'! recordConflict: conflict between: priorOwner and: newOwner "Record a conflict between the prior owner and the new owner. We suppress pseudo-conflicts between the base system and a particular patch to allow overrides in packages" priorOwner = '' ifTrue:[^self]. "override of base method / class definition" logFile ifNotNil:[ logFile crtab; nextPutAll: conflict, ' (conflicts with ', priorOwner, ')'; flush. ]. conflicts ifNotNil:[ conflicts add: conflict -> {priorOwner. newOwner}. ].! ! !ConflictFinder methodsFor: 'running' stamp: 'ar 12/16/2008 20:21'! updateConflicts: patchName class: aClass "Check whether the ownership of the given class has changed. The method to do this relies on associating ownership with each method and class definition and, after having loaded the patch, testing if the newly executed patchAction has changed ownership of any definition." | owner oldDef newDef methodKey oldStamp newStamp | "Determine (previous) ownership for the class definition" oldDef := definitions at: aClass name ifAbsent:[nil]. newDef := aClass definition. oldDef = newDef ifFalse:[ "The patch has modified the class definition, check for ownership" owner := ownership at: aClass name ifAbsentPut:[patchName]. owner = patchName ifFalse:[ "Houston, we have a conflict" self recordConflict: aClass name between: owner and: patchName. ]. "Remember definition, assign new ownership" definitions at: aClass name put: newDef. ownership at: aClass name put: patchName. ]. "Now do the same for each method in the given class" aClass selectorsAndMethodsDo:[:sel :method| methodKey := aClass name, '>>', sel. oldStamp := definitions at: methodKey ifAbsent:[nil]. newStamp := method timeStamp. oldStamp = newStamp ifFalse:[ "The patch modified the method, check ownership" owner := ownership at: methodKey ifAbsentPut:[patchName]. (owner = patchName) ifFalse:[ "Houston, we have a conflict" self recordConflict: methodKey between: owner and: patchName. ]. "Remember definition, assign new ownership" definitions at: methodKey put: newStamp. ownership at: methodKey put: patchName. ]. ].! ! !ConflictFinder methodsFor: 'running' stamp: 'ar 12/16/2008 21:47'! updateConflicts: patchName notifying: progress "Having run a particular action, go through the entire system and find possible conflicts." | allClasses aClass | allClasses := environment values asArray select:[:each| each isBehavior]. 1 to: allClasses size do:[:i| aClass := allClasses at: i. self updateConflicts: patchName class: aClass. self updateConflicts: patchName class: aClass class. progress ifNotNil:[progress value: i / allClasses size asFloat]. ].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ConflictFinder class instanceVariableNames: ''! !ConflictFinder class methodsFor: 'instance creation' stamp: 'ar 12/16/2008 20:18'! findConflictsIn: anArrayOfAssociations ^self new findConflictsIn: anArrayOfAssociations! ! !ConflictFinder class methodsFor: 'instance creation' stamp: 'ar 12/16/2008 20:18'! findConflictsIn: anArrayOfAssociations notifying: progress ^self new findConflictsIn: anArrayOfAssociations notifying: progress! ! TestCase subclass: #ConflictFinderTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ConflictFinder'! !ConflictFinderTest commentStamp: '' prior: 0! Tests for ConflictFinder.! !ConflictFinderTest methodsFor: 'tests' stamp: 'ar 12/16/2008 21:15'! testClassConflict "Test that two actions which result in a class definition conflict are recorded properly" | conflicts oldCat | self withConflictFinderDo:[:finder| oldCat := self class category. [conflicts := finder findConflictsIn:{ 'PatchA' -> [SystemOrganization classify: self class name under: oldCat,'-Test']. 'PatchB' -> [SystemOrganization classify: self class name under: oldCat]. } notifying: nil] ensure:[SystemOrganization classify: self class name under: oldCat]. ]. self assert: conflicts size = 1. self assert: conflicts first key = self class name. self assert: conflicts first value = #('PatchA' 'PatchB'). ! ! !ConflictFinderTest methodsFor: 'tests' stamp: 'ar 12/16/2008 21:17'! testMethodConflict "Test that two actions which result in a method definition conflict are recorded properly" | conflicts | self withConflictFinderDo:[: finder| [conflicts := finder findConflictsIn:{ 'PatchA' -> [Utilities setAuthorInitials: 'testA'. self class compile: 'frobler ^123' classified: 'tests']. 'PatchB' -> [Utilities setAuthorInitials: 'testB'. self class compile: 'frobler ^456' classified: 'tests']. } notifying: nil] ensure:[self class removeSelector: #frobler]. ]. self assert: conflicts size = 1. self assert: conflicts first key = (self class name, '>>frobler'). self assert: conflicts first value = #('PatchA' 'PatchB'). ! ! !ConflictFinderTest methodsFor: 'tests' stamp: 'ar 12/16/2008 21:15'! testNoOverrideConflict "Test that an override (a modification of a 'base' method) is not reported as conflict" | conflicts | self withConflictFinderDo:[: finder| [Utilities setAuthorInitials: 'testA'. self class compile: 'frobler ^123' classified: 'tests'. conflicts := finder findConflictsIn:{ 'PatchB' -> [Utilities setAuthorInitials: 'testA'. self class compile: 'frobler ^456' classified: 'tests']. }notifying: nil] ensure:[self class removeSelector: #frobler]. ]. self assert: conflicts isEmpty. ! ! !ConflictFinderTest methodsFor: 'tests' stamp: 'ar 12/16/2008 21:17'! withConflictFinderDo: aBlock | finder initials | finder := ConflictFinder new. finder environment: ((Dictionary new) at: self class name put: self class; yourself). finder logFile: nil. "disable for testing" initials := Utilities authorInitialsPerSe. [aBlock value: finder] ensure:[ Utilities setAuthorInitials: initials. ].! !