changed:5 methods
authorClaus Gittinger <cg@exept.de>
Wed, 07 Apr 2010 20:21:18 +0200
changeset 12859 f973aadfb3d2
parent 12858 695cbd35ce8a
child 12860 980b550b72e6
changed:5 methods getting rid of subclassInfo, keep it in the instance
Class.st
--- a/Class.st	Wed Apr 07 20:08:01 2010 +0200
+++ b/Class.st	Wed Apr 07 20:21:18 2010 +0200
@@ -374,6 +374,9 @@
      This is private protocol"
 
     SubclassInfo := nil.
+    self allSubInstancesDo:[:cls |
+        cls flushSubclasses
+    ].
 
     "
      Class flushSubclassInfo
@@ -390,7 +393,8 @@
     aClass notNil ifTrue:[
         SubclassInfo notNil ifTrue:[
             SubclassInfo removeKey:aClass ifAbsent:[]
-        ]
+        ].
+        aClass flushSubclasses
     ].
 
     "
@@ -411,22 +415,22 @@
 
     |d|
 
-    SubclassInfo notNil ifTrue:[^ SubclassInfo].
-
-    d := IdentityDictionary new.
-    Smalltalk allClassesDo:[:aClass |
-        |superCls setToAddSubclass|
-
-        superCls := aClass superclass.
-        superCls notNil ifTrue:[
-            setToAddSubclass := d at:superCls ifAbsent:nil.
-            setToAddSubclass isNil ifTrue:[
-                d at:superCls put:(Set with:aClass).
-            ] ifFalse:[
-                setToAddSubclass add:aClass
-            ]
-        ]
-    ].
+"/    SubclassInfo notNil ifTrue:[^ SubclassInfo].
+"/
+"/    d := IdentityDictionary new.
+"/    Smalltalk allClassesDo:[:aClass |
+"/        |superCls setToAddSubclass|
+"/
+"/        superCls := aClass superclass.
+"/        superCls notNil ifTrue:[
+"/            setToAddSubclass := d at:superCls ifAbsent:nil.
+"/            setToAddSubclass isNil ifTrue:[
+"/                d at:superCls put:(Set with:aClass).
+"/            ] ifFalse:[
+"/                setToAddSubclass add:aClass
+"/            ]
+"/        ]
+"/    ].
     SubclassInfo := d.
     ^ d
 
@@ -2028,34 +2032,13 @@
      This will only enumerate globally known classes - for anonymous
      behaviors, you have to walk over all instances of Behavior."
 
-    |coll|
-
-    "/ use cached information (avoid class hierarchy search)
-    "/ if possible
-    SubclassInfo isNil ifTrue:[
-        Class subclassInfo   "/ creates SubclassInfo as side effect
-    ].
-    SubclassInfo notNil ifTrue:[
-        coll := SubclassInfo at:self ifAbsent:nil.
-        coll notNil ifTrue:[
-            coll do:aBlock.
-            ^ self
-        ].
+    "/ use cached information (avoid class hierarchy search), if possible
+    subclasses notNil ifTrue:[
+        subclasses do:aBlock
+    ] ifFalse:[
+        super subclassesDo:aBlock
     ].
 
-    coll := OrderedCollection new.
-    Smalltalk allClassesDo:[:aClass |
-        (aClass superclass == self) ifTrue:[
-            coll add:aClass
-        ]
-    ].
-
-    SubclassInfo notNil ifTrue:[
-        SubclassInfo at:self put:coll.
-    ].
-
-    coll do:aBlock.
-
     "
      Collection subclassesDo:[:c | Transcript showCR:(c name)]
     "
@@ -3541,6 +3524,10 @@
     "Modified: / 06-03-2007 / 11:54:53 / cg"
 !
 
+flushSubclasses
+    subclasses := nil
+!
+
 hasExtensions
     "return true, if there are methods in the receiver, which belong to
      a different package (i.e. package of class ~= package of method).
@@ -3692,24 +3679,11 @@
 subclasses
     "return a collection of the direct subclasses of the receiver"
 
-    |newColl|
-
-    "/ use cached information (avoid class hierarchy search)
-    "/ if possible
-
-    SubclassInfo notNil ifTrue:[
-        newColl := SubclassInfo at:self ifAbsent:nil.
-        newColl notNil ifTrue:[^ newColl asOrderedCollection]
+    "/ use cached information (avoid class hierarchy search), if possible
+    subclasses isNil ifTrue:[
+        subclasses := super subclasses asArray.
     ].
-
-    newColl := OrderedCollection new.
-    self subclassesDo:[:aClass |
-        newColl add:aClass
-    ].
-    SubclassInfo notNil ifTrue:[
-        SubclassInfo at:self put:newColl.
-    ].
-    ^ newColl
+    ^ subclasses
 
     "
      Class flushSubclassInfo.
@@ -5070,9 +5044,9 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.569 2010-04-07 17:51:57 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.570 2010-04-07 18:21:18 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.569 2010-04-07 17:51:57 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.570 2010-04-07 18:21:18 cg Exp $'
 ! !