Folks -

In light of Greg's recent issues with conflicts between packages I spent 
this evening writing a little tool called ConflictFinder. What it does 
is taking a set of actions and computes conflicts arising from running 
these actions. In its simplest use it works like here:

ConflictFinder findConflictsIn:{
   'FooPackage'    -> [(FileStream readOnlyFileNamed: 'Foo.st') fileIn].
   'MantisFix1234' -> [Installer mantis ensureFix: 1234].
   'Mumble'        -> [MczInstaller installFileNamed: 'Foo-xyz.123.mcz'].
}.

It prints the analysis to the transcript by default but you can override 
its log file appropriately. Since I didn't know how to get the universe 
browser to load stuff automatically, I decided to cheat and run it like 
here to test it on the problem in question:

ConflictFinder findConflictsIn:{
   'SmallDEVS'	->	[self notify: 'Please load SmallDEVS'].
   'Polymorph'	->	[self notify: 'Please load Polymorph'].
}.

After loading the packages manually when prompted the analysis showed 
this result:

	LabelMorph (conflicts with SmallDEVS)
	LabelMorph>>initialize (conflicts with SmallDEVS)
	LabelMorph>>drawOn: (conflicts with SmallDEVS)
	StringMorph>>minHeight (conflicts with SmallDEVS)

So there is a conflict between LabelMorph in the packages *as well as* 
StringMorph>>minHeight (which happens to be an equivalent modification 
but shows that the tool does indeed unearth unexpected conflicts).

The next step would be to find someone who ties this into the universe 
browser and just starts loading packags randomly. At which point a 
concerted community action of just people reporting back their results 
should be able of finding 90% of the conflicts in the current PU in no time.

Any volunteers for helping with this?

Cheers,
   - Andreas
-------------- next part --------------
Object subclass: #ConflictFinder
	instanceVariableNames: 'environment ownership definitions conflicts logFile'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ConflictFinder'!
!ConflictFinder commentStamp: '<historical>' 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: '<historical>' 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.
	].! !