[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
|