Metaclass.st
changeset 3282 9cb867744e4c
parent 3278 bbc08c1a165d
child 3379 422c91c556c5
--- 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!