when loading a class, the original definition's state is lost; move it over
authorClaus Gittinger <cg@exept.de>
Mon, 19 Oct 2009 22:06:47 +0200
changeset 12294 c46be62dee24
parent 12293 983b9555f6e8
child 12295 fbd977f707de
when loading a class, the original definition's state is lost; move it over
ProjectDefinition.st
--- a/ProjectDefinition.st	Mon Oct 19 16:15:58 2009 +0200
+++ b/ProjectDefinition.st	Mon Oct 19 22:06:47 2009 +0200
@@ -2800,7 +2800,7 @@
      Answer true, if new classes have been installed for this package,
      false if the package's classes have been already present."
 
-    |newStuffHasBeenLoaded|
+    |newStuffHasBeenLoaded meOrMySecondIncarnation|
 
     self projectIsLoaded ifTrue:[^ false].
     thisContext isRecursive ifTrue:[^ false].    "/ avoid endless loops
@@ -2810,6 +2810,7 @@
     newStuffHasBeenLoaded := false.
 
     (self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
+self halt.
         "/ thisContext fullPrintAll.
         Transcript show:'loading '.
         asAutoloaded ifTrue:[
@@ -2822,23 +2823,32 @@
 
     self activityNotification:'Executing pre-load action'.
     self preLoadAction.
+
+    meOrMySecondIncarnation := self.
+
     Class withoutUpdatingChangesDo:[
         self activityNotification:'Loading prerequisities'.
         self loadPreRequisitesAsAutoloaded:asAutoloaded.
         asAutoloaded ifFalse:[
             self loadClassLibrary.
+            "/ could have overloaded my first incarnation
+            meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
+            meOrMySecondIncarnation ~~ self ifTrue:[
+                meOrMySecondIncarnation fetchSlotsFrom:self.
+            ].
         ].
 
         self activityNotification:'Loading extensions'.
-        newStuffHasBeenLoaded := newStuffHasBeenLoaded | self loadExtensions.
+        newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
         self activityNotification:'Loading classes'.
-        newStuffHasBeenLoaded := newStuffHasBeenLoaded | (self loadAllClassesAsAutoloaded:asAutoloaded).
+        newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
         self activityNotification:'Loading sub projects'.
-        self loadSubProjectsAsAutoloaded:asAutoloaded.
+        meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
     ].
     self activityNotification:'Executing post-load action'.
-    self postLoadAction.
-    self projectIsLoaded:true.
+    meOrMySecondIncarnation postLoadAction.
+self halt.
+    meOrMySecondIncarnation projectIsLoaded:true.
 
     ^ newStuffHasBeenLoaded
 
@@ -4132,6 +4142,18 @@
     "/ todo: more needed here...
 !
 
+extensionOverwriteInfo
+    ^ extensionOverwriteInfo
+!
+
+fetchSlotsFrom:myFirstIncarnation
+    "this is invoked in a just loaded instance of myself,
+     to fetch the safe and extensionInfo from my first incarnation"
+
+    safeForOverwrittenMethods := myFirstIncarnation safeForOverwrittenMethods.
+    extensionOverwriteInfo := myFirstIncarnation extensionOverwriteInfo.
+!
+
 loadAllClassesAsAutoloaded:asAutoloaded
     "load (fileIn) classes that should be present -
      install as autoloaded classes marked to be autoloaded.
@@ -4253,15 +4275,22 @@
     "try to load a binary class library
      Return true if ok, false if not."
 
-    |libraryName|
+    |libraryName meBefore meAfter retVal|
 
     libraryName := self libraryName.
 
     (Smalltalk isClassLibraryLoaded:libraryName) ifTrue:[
         "already loaded"
         ^ true 
-    ].  
-    ^ Smalltalk fileInClassLibrary:libraryName inPackage:self package
+    ]. 
+    meBefore := self.
+    retVal := Smalltalk fileInClassLibrary:libraryName inPackage:self package.
+    "/ the binary-load could have (usually has) overloaded me
+    meAfter := Smalltalk at:(self name).
+    meBefore == meAfter ifFalse:[
+        self halt.
+    ].
+    ^ retVal.
 !
 
 loadExtensions
@@ -4308,6 +4337,10 @@
     "Modified: / 25-10-2006 / 17:51:58 / cg"
 !
 
+safeForOverwrittenMethods
+    ^ safeForOverwrittenMethods
+!
+
 update:anAspectSymbol with:argument from:changedObject
     "when any of my class methods is changed, we mark the project as unloaded.
      May be some mor classes have to be loaded"
@@ -4680,11 +4713,11 @@
 !ProjectDefinition class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.255 2009-10-19 14:15:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.256 2009-10-19 20:06:47 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.255 2009-10-19 14:15:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.256 2009-10-19 20:06:47 cg Exp $'
 ! !
 
 ProjectDefinition initialize!