handle nil-subclasses in binaryLoad
authorClaus Gittinger <cg@exept.de>
Tue, 22 Oct 1996 21:37:23 +0200
changeset 1802 f9148cfae747
parent 1801 74d0e3858ded
child 1803 754f9205b651
handle nil-subclasses in binaryLoad
Class.st
--- a/Class.st	Tue Oct 22 21:34:31 1996 +0200
+++ b/Class.st	Tue Oct 22 21:37:23 1996 +0200
@@ -1031,7 +1031,7 @@
     |superclassName name flags instvars classvars category classInstVars
      comment package superclassSig rev
      newClass superClass methods cmethods formatID environment
-     ownerName owner nPrivate privateClass|
+     ownerName owner nPrivate privateClass cls|
 
     "/ the following order must correlate to
     "/ the storing in #storeBinaryClassOn:manager:
@@ -1114,35 +1114,44 @@
 
 "/ ('create class: ' ,  name ) printNL.
 
-    (superClass notNil or:[superclassName isNil]) ifTrue:[
-        owner notNil ifTrue:[
-            environment := owner
-        ] ifFalse:[
-            environment := Class nameSpaceQuerySignal raise.
-        ].
-
-        newClass := superClass class
-                name:name asSymbol
-                in:environment
-                subclassOf:superClass
-                instanceVariableNames:instvars
-                variable:false
-                words:false 
-                pointers:true
-                classVariableNames:classvars
-                poolDictionaries:'' 
-                category:category
-                comment:comment 
-                changed:false 
-                classInstanceVariableNames:classInstVars.
-
-        newClass isNil ifTrue:[
-            ^ nil.
-        ].
+    owner notNil ifTrue:[
+        environment := owner
+    ] ifFalse:[
+        environment := Class nameSpaceQuerySignal raise.
+    ].
+
+    cls := superClass.
+    superClass isNil ifTrue:[
+        cls := Object
+    ].
+
+    newClass := cls class
+            name:name asSymbol
+            in:environment
+            subclassOf:cls
+            instanceVariableNames:instvars
+            variable:false
+            words:false 
+            pointers:true
+            classVariableNames:classvars
+            poolDictionaries:'' 
+            category:category
+            comment:comment 
+            changed:false 
+            classInstanceVariableNames:classInstVars.
+
+    newClass isNil ifTrue:[
+        ^ nil.
+    ].
+
+    superClass isNil ifTrue:[
+        newClass setSuperclass:nil.
+        newClass class setSuperclass:Class.
+    ].
+
 "/ Transcript showCR:'loaded ' , name , ' in ' , environment name.
 
-        newClass flags:flags.
-    ].
+    newClass flags:flags.
 
     "/ retrieve class methods
     cmethods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager.
@@ -1178,7 +1187,7 @@
 
     "Modified: 7.6.1996 / 13:43:06 / stefan"
     "Created: 8.10.1996 / 17:57:02 / cg"
-    "Modified: 15.10.1996 / 21:20:28 / cg"
+    "Modified: 22.10.1996 / 20:31:38 / cg"
 !
 
 storeBinaryClassOn:stream manager:manager
@@ -4106,6 +4115,6 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.193 1996-10-18 21:14:37 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.194 1996-10-22 19:37:23 cg Exp $'
 ! !
 Class initialize!