--- a/Metaclass.st Sat Feb 07 17:22:07 1998 +0100
+++ b/Metaclass.st Sat Feb 07 21:30:44 1998 +0100
@@ -231,15 +231,13 @@
newClass category:(oldClass category).
(t := oldClass primitiveSpec) notNil ifTrue:[
newClass primitiveSpec:t.
- newClass setClassFilename:(oldClass classFilename).
].
+ newClass setClassFilename:(oldClass classFilename).
"/ set the new classes package
"/ from the old package
- t := oldClass package.
- "/ newMetaclass package:t.
- newClass package:t.
+ newClass package:(oldClass package).
"/ and keep the binary revision
newClass setBinaryRevision:(oldClass binaryRevision).
@@ -262,8 +260,8 @@
addedNames := newNames select:[:nm | (oldNames includes:nm) not].
-"/ Transcript showCR:'recompiling methods accessing ' , addedNames printString , '...'.
-"/ Transcript endEntry.
+ Transcript showCR:'recompiling class methods of ' , newMetaclass name ,
+ ' accessing any of ' , addedNames printString.
"recompile class-methods"
newMetaclass recompileMethodsAccessingAny:addedNames.
@@ -302,8 +300,8 @@
]
].
-"/ Transcript showCR:'recompiling methods accessing ' , changeSet printString , ' ...'.
-"/ Transcript endEntry.
+ Transcript showCR:'recompiling class methods of ' , newMetaclass name ,
+ ' accessing any of ' , changeSet printString.
"
recompile class-methods
@@ -316,6 +314,18 @@
delta := newNames size - oldNames size.
+ "/ preserve existing classInstVar values (but not thise from Class)
+ newMetaclass allInstVarNames do:[:nm |
+ |v|
+
+ (Class class allInstVarNames includes:nm) ifFalse:[
+ v := oldClass instVarNamed:nm ifAbsent:nil.
+ v notNil ifTrue:[
+ newClass instVarNamed:nm put:v.
+ ].
+ ].
+ ].
+
"
get list of all subclasses - do before superclass is changed
"
@@ -351,16 +361,39 @@
] ifFalse:[
newSub setSuperclass:(oldToNew at:oldSuper).
].
- newSub setMethodDictionary:(aSubclass methodDictionary copy).
- newSub class setMethodDictionary:(aSubclass class methodDictionary copy).
+
+"/ newSub setMethodDictionary:(aSubclass methodDictionary copy).
+"/ newSub class setMethodDictionary:(aSubclass class methodDictionary copy).
newSub setName:(aSubclass name).
newSub classVariableString:(aSubclass classVariableString).
+ newSub setInstanceVariableString:(aSubclass instanceVariableString).
+ (t := aSubclass primitiveSpec) notNil ifTrue:[
+ newSub primitiveSpec:t.
+ ].
+ newSub package:(aSubclass package).
+ newSub setClassFilename:(oldClass classFilename).
newSub setComment:(aSubclass comment).
newSub category:(aSubclass category).
+ newSub instSize:(aSubclass instSize).
+ newSub setBinaryRevision:(aSubclass binaryRevision).
oldToNew at:aSubclass put:newSub.
aSubclass category:#'* obsolete *'.
+
+ "/ preserve existing classInstVar values (but not thise from Class)
+
+ newSubMeta allInstVarNames do:[:nm |
+ |v|
+
+ (Class class allInstVarNames includes:nm) ifFalse:[
+ v := aSubclass instVarNamed:nm ifAbsent:nil.
+ v notNil ifTrue:[
+ newSub instVarNamed:nm put:v.
+ ].
+ ].
+ ].
+
].
"recompile what needs to be"
@@ -378,7 +411,16 @@
Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
' accessing any of ' , changeSet printString.
- newSubclass class recompileMethodsAccessingAny:changeSet.
+ self
+ copyInvalidatedMethodsFrom:oldSubclass class for:newSubclass class
+ accessingAny:changeSet orSuper:true.
+
+ self
+ copyInvalidatedMethodsFrom:oldSubclass for:newSubclass
+ accessingAny:#() orSuper:true.
+
+ newSubclass class recompileInvalidatedMethods.
+ newSubclass recompileInvalidatedMethods.
]
] ifFalse:[
"
@@ -401,7 +443,16 @@
Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
' accessing any of ' , classInstVars printString.
- newSubclass class recompileMethodsAccessingAny:classInstVars.
+ self
+ copyInvalidatedMethodsFrom:oldSubclass class for:newSubclass class
+ accessingAny:classInstVars orSuper:true.
+
+ self
+ copyInvalidatedMethodsFrom:oldSubclass for:newSubclass
+ accessingAny:#() orSuper:true.
+
+ newSubclass class recompileInvalidatedMethods.
+ newSubclass recompileInvalidatedMethods.
]
].
@@ -412,12 +463,13 @@
(Smalltalk at:(oldClass name asSymbol) ifAbsent:nil) == oldClass ifTrue:[
Smalltalk at:(oldClass name asSymbol) put:newClass.
self checkForAliasesOf:oldClass with:newClass.
- "
- change any private subclasses' owners
- "
- oldClass privateClassesDo:[:aClass |
- aClass class setOwningClass:newClass
- ].
+
+ "
+ change any private subclasses' owners
+ "
+ oldClass privateClassesDo:[:aClass |
+ aClass class setOwningClass:newClass
+ ].
].
ObjectMemory flushCachesFor:oldClass.
@@ -444,9 +496,9 @@
^ newMetaclass
- "Created: 29.10.1995 / 19:57:08 / cg"
- "Modified: 1.4.1997 / 15:44:09 / stefan"
- "Modified: 16.6.1997 / 11:30:53 / cg"
+ "Created: / 29.10.1995 / 19:57:08 / cg"
+ "Modified: / 1.4.1997 / 15:44:09 / stefan"
+ "Modified: / 7.2.1998 / 21:27:08 / cg"
! !
!Metaclass methodsFor:'copying'!
@@ -1888,6 +1940,6 @@
!Metaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.121 1998-02-05 17:02:18 tz Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.122 1998-02-07 20:30:44 cg Exp $'
! !
Metaclass initialize!