[FIX] for duplicating 'new class arrived'

Bergel Alexandre bergel at iam.unibe.ch
Sat May 25 20:35:33 UTC 2002


When loading a segment, check for new class arriving is only performed on the symbol, and not with the module.

-- 
_,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._
Bergel Alexandre  http://www.iam.unibe.ch/~bergel
^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4827] on 25 May 2002 at 10:22:15 pm'!

!ImageSegment methodsFor: 'fileIn/Out' stamp: 'ab 5/25/2002 22:18'!
declareAndPossiblyRename: classThatIsARoot 
	"The class just arrived in this segment. How fit it into the Smalltalk  
	dictionary? If it had an association, that was installed with  
	associationDeclareAt:."
	| existing catInstaller |
	catInstaller _ [classThatIsARoot superclass name == #Player
				ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
				ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
						ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
						ifFalse: [classThatIsARoot category: 'Morphic-Imported']]].
	classThatIsARoot superclass addSubclass: classThatIsARoot.
	(Smalltalk includesKey: classThatIsARoot name)
		ifFalse: ["Class entry in Smalltalk not referred to in Segment, install  
			anyway."
			catInstaller value.
			^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
	existing _ Smalltalk at: classThatIsARoot name.
	existing xxxClass == ImageSegmentRootStub
		ifTrue: ["We are that segment!! Must ask it carefully!!"
			catInstaller value.
			^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
	existing == false | (existing == nil)
		ifTrue: ["association is in outPointers, just installed"
			catInstaller value.
			^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
	"Conflict with existing global or copy of the class"
	(existing isKindOf: Class)
		ifTrue: [classThatIsARoot isSystemDefined not
				ifTrue: ["UniClass. give it a new name"
					classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
					catInstaller value.
					"must be after new name"
					^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
			"Take the incoming one"
			existing module = classThatIsARoot module
				ifTrue: [self inform: 'Using newly arrived version of ' , classThatIsARoot name].
			classThatIsARoot superclass removeSubclass: classThatIsARoot.
			"just in case"
			(Smalltalk at: classThatIsARoot name)
				becomeForward: classThatIsARoot.
			catInstaller value.
			^ classThatIsARoot superclass addSubclass: classThatIsARoot].
	self error: 'Name already in use by a non-class: ' , classThatIsARoot name!
]style[(26 16 3 162 3 22 4 12 4 16 20 7 14 16 11 6 39 16 29 17 17 16 11 23 18 16 11 18 6 16 25 16 4 9 14 16 19 75 4 12 13 9 5 16 11 16 4 8 3 9 5 16 8 8 13 20 12 45 4 12 13 9 5 16 11 16 4 8 4 5 4 8 4 3 13 47 4 12 13 9 5 16 11 16 4 52 3 8 11 5 13 16 34 30 6 16 10 16 42 12 13 24 8 9 5 16 11 16 6 23 4 8 10 16 21 4 9 33 3 16 11 16 28 16 5 14 5 9 5 16 26 16 5 12 13 16 25 16 4 4 8 38 3 16 5)f1b,f1cblue;b,f1,f1c152050000,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c152050000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1c152050000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1c152050000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1c152050000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c152050000,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c152050000,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1c152050000,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1c202202126,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c152050000,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1c202202126,f1,f1cblue;i,f1! !


More information about the Squeak-dev mailing list