--- a/Class.st Fri Dec 09 23:15:57 2011 +0000
+++ b/Class.st Wed Dec 21 22:04:49 2011 +0000
@@ -15,11 +15,19 @@
instanceVariableNames:'name category classvars comment subclasses classFilename package
revision environment signature attributes'
classVariableNames:'DefaultCategoryForSTV DefaultCategoryForVAGE
- DefaultCategoryForDolphin ValidateSourceOnlyOnce ValidatedClasses'
+ DefaultCategoryForDolphin ValidateSourceOnlyOnce ValidatedClasses
+ SubclassCacheSequenceNumber'
poolDictionaries:''
category:'Kernel-Classes'
!
+Array variableSubclass:#ArrayWithSequenceNumberValidation
+ instanceVariableNames:'sequenceNumber'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Class
+!
+
Object subclass:#ClassAttributes
instanceVariableNames:'primitiveDefinitions primitiveVariables primitiveFunctions
sharedPools traitComposition localSelectors vGuid fGuid'
@@ -393,16 +401,17 @@
by #subclassInfo.
This is private protocol"
- SubclassInfo := nil.
- self allSubInstancesDo:[:cls |
- cls flushSubclasses
- ].
+ SubclassCacheSequenceNumber := (SubclassCacheSequenceNumber ? 0) + 1.
+
+"/ self allSubInstancesDo:[:cls |
+"/ cls flushSubclasses
+"/ ].
"
Class flushSubclassInfo
"
- "Modified: 22.1.1997 / 18:39:36 / cg"
+ "Modified: / 06-12-2011 / 16:20:13 / cg"
!
flushSubclassInfoFor:aClass
@@ -411,54 +420,14 @@
This is private protocol"
aClass notNil ifTrue:[
- SubclassInfo notNil ifTrue:[
- SubclassInfo removeKey:aClass ifAbsent:[]
- ].
- aClass flushSubclasses
+ aClass flushSubclasses
].
"
Class flushSubclassInfoFor:View
"
- "Modified: 22.1.1997 / 18:39:36 / cg"
-!
-
-subclassInfo
- "build & return a dictionary, containing the set of subclass
- for each class. This information is kept until explicitely flushed
- by #flushSubclassInfo.
- This cache is used internally, for enumerators like #allSubclasses
- or #allSubclassesDo:, to avoid repeated recursive walks over the class
- hierarchy.
- This is private protocol."
-
- |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 := d.
- ^ d
-
- "
- Class subclassInfo
- "
-
- "Modified: 22.1.1997 / 18:44:59 / cg"
+ "Modified: / 06-12-2011 / 16:20:49 / cg"
! !
!Class class methodsFor:'queries'!
@@ -1780,10 +1749,11 @@
"return a collection of the direct subclasses of the receiver"
"/ use cached information (avoid class hierarchy search), if possible
- subclasses isNil ifTrue:[
- self updateAllCachedSubclasses.
- "subclasses may still be nil - obsolete classes may not be updated"
- ^ subclasses ? #().
+ (subclasses isNil
+ or:[ subclasses sequenceNumber ~= SubclassCacheSequenceNumber ]) ifTrue:[
+ self updateAllCachedSubclasses.
+ "subclasses may still be nil - obsolete classes may not be updated"
+ ^ subclasses ? #().
].
^ subclasses.
@@ -1793,7 +1763,7 @@
SmallInteger subclasses
"
- "Modified: / 23-05-2011 / 17:33:43 / cg"
+ "Modified: / 06-12-2011 / 16:05:16 / cg"
!
superclass:aClass
@@ -2233,18 +2203,13 @@
This will only enumerate globally known classes - for anonymous
behaviors, you have to walk over all instances of Behavior."
- "/ use cached information (avoid class hierarchy search), if possible
- subclasses isNil ifTrue:[
- self updateAllCachedSubclasses.
- subclasses isNil ifTrue:[subclasses := #()].
- ].
- subclasses do:aBlock
+ self subclasses do:aBlock
"
Collection subclassesDo:[:c | Transcript showCR:(c name)]
"
- "Modified: / 13-10-2010 / 12:39:13 / cg"
+ "Modified: / 06-12-2011 / 15:59:49 / cg"
!
withAllPrivateClassesDo:aBlock
@@ -3574,24 +3539,36 @@
!
updateAllCachedSubclasses
- |subclassesPerClass|
+ |subclassesPerClass seqNr makeNewSet|
+
+ makeNewSet := [Set new].
subclassesPerClass := Dictionary new.
Smalltalk allClassesDo:[:each |
- |cls superclass|
-
- cls := each theNonMetaclass.
- (superclass := each superclass) notNil ifTrue:[
- (subclassesPerClass at:superclass ifAbsentPut:[Set new]) add:cls
- ].
- subclassesPerClass at:cls ifAbsentPut:[Set new].
+ |cls superclass|
+
+ cls := each theNonMetaclass.
+ (superclass := each superclass) notNil ifTrue:[
+ (subclassesPerClass at:superclass ifAbsentPut:makeNewSet) add:cls
+ ].
+ subclassesPerClass at:cls ifAbsentPut:makeNewSet.
].
+
+ SubclassCacheSequenceNumber isNil ifTrue:[
+ SubclassCacheSequenceNumber := 0.
+ ].
+ seqNr := SubclassCacheSequenceNumber.
subclassesPerClass keysAndValuesDo:[:cls :subclasses |
- cls setSubclasses:(subclasses asArray).
+ |coll|
+
+ coll := ArrayWithSequenceNumberValidation withAll:subclasses.
+ coll sequenceNumber:seqNr.
+ cls setSubclasses:coll.
].
"
Class updateAllCachedSubclasses
+ Array subclasses
"
"Created: / 28-04-2010 / 08:47:20 / cg"
@@ -5265,6 +5242,24 @@
"Created: / 16-08-2009 / 12:57:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
+!Class::ArrayWithSequenceNumberValidation methodsFor:'accessing'!
+
+sequenceNumber
+ ^ sequenceNumber
+!
+
+sequenceNumber:something
+ sequenceNumber := something.
+! !
+
+!Class::ArrayWithSequenceNumberValidation methodsFor:'checking'!
+
+checkIfValidFor:aSequenceNumber
+ ^ aSequenceNumber ~= sequenceNumber
+
+ "Created: / 06-12-2011 / 16:01:16 / cg"
+! !
+
!Class::ClassAttributes class methodsFor:'documentation'!
documentation
@@ -5508,13 +5503,14 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Id: Class.st 10748 2011-12-08 18:18:15Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.600 2011/12/06 15:21:38 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.598 2011/10/03 08:30:36 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.600 2011/12/06 15:21:38 cg Exp §'
!
version_SVN
- ^ '$Id: Class.st 10748 2011-12-08 18:18:15Z vranyj1 $'
+ ^ '$Id: Class.st 10751 2011-12-21 22:04:49Z vranyj1 $'
! !
+