--- 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 $'
! !