A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-ct.1356.mcz ==================== Summary ==================== Name: Kernel-ct.1356 Author: ct Time: 28 October 2020, 9:05:21.976652 pm UUID: 27e8ca85-1191-5b4b-aa8c-92b65e01af50 Ancestors: Kernel-eem.1354 Fixes and refactors ClassBuilder cleanupAndCheckClassHierarchy which was broken due to a missing #informUserDuring: implementation. Also adds progress bars during the operation. =============== Diff against Kernel-eem.1354 =============== Item was changed: ----- Method: ClassBuilder class>>checkClassHierarchyConsistency (in category 'cleanup obsolete classes') ----- checkClassHierarchyConsistency "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following two logical equivalences hold for classes A and B: - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" + + Transcript cr; show: 'Start checking the class hierarchy...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. + self checkClassHierarchyConsistencyFor: meta] + displayingProgress: 'Validating class hierarchy' translated. + + Transcript show: 'OK'.! - self informUserDuring:[:bar| - self checkClassHierarchyConsistency: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>checkClassHierarchyConsistency: (in category 'cleanup obsolete classes') ----- - checkClassHierarchyConsistency: informer - "Check the consistency of the class hierarchy. The class hierarchy is consistent if the following - two logical equivalences hold for classes A and B: - - B is obsolete and 'B superclass' yields A <--> 'A obsoleteSubclasses' contains B - - B is not obsolete and 'B superclass' yields A <--> 'A subclasses' contains B" - | classes | - Transcript cr; show: 'Start checking the class hierarchy...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Validating class hierarchy ', (index * 100 // classes size) printString,'%'. - meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each]. - self checkClassHierarchyConsistencyFor: meta. - ]. - Transcript show: 'OK'.! Item was changed: ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupAndCheckClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. Afterwards it checks whether the hierarchy is really consistent." + + Project uiManager informUser: 'Cleaning up class hierarchy...' translated during: [ + Transcript cr; show: '*** Before cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses. + self cleanupClassHierarchy. + self checkClassHierarchyConsistency. + Transcript cr; cr; show: '*** After cleaning up ***'. + self countReallyObsoleteClassesAndMetaclasses].! - self informUserDuring:[:bar| - self cleanupAndCheckClassHierarchy: bar. - ]. - ! Item was removed: - ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupAndCheckClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary. - Afterwards it checks whether the hierarchy is really consistent." - - Transcript cr; show: '*** Before cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses. - self cleanupClassHierarchy: informer. - self checkClassHierarchyConsistency: informer. - Transcript cr; cr; show: '*** After cleaning up ***'. - self countReallyObsoleteClassesAndMetaclasses.! Item was changed: ----- Method: ClassBuilder class>>cleanupClassHierarchy (in category 'cleanup obsolete classes') ----- cleanupClassHierarchy "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." + + Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. + Smalltalk garbageCollect. + + Metaclass allInstances + do: [:meta | + "Check classes before metaclasses (because Metaclass>>isObsolete checks whether the related class is obsolete)" + meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. + self cleanupClassHierarchyFor: meta] + displayingProgress: 'Fixing class hierarchy' translated. + + Transcript show: 'DONE'.! - self informUserDuring:[:bar| - self cleanupClassHierarchy: bar. - ].! Item was removed: - ----- Method: ClassBuilder class>>cleanupClassHierarchy: (in category 'cleanup obsolete classes') ----- - cleanupClassHierarchy: informer - "Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary." - | classes | - Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'. - Smalltalk garbageCollect. - classes := Metaclass allInstances. - classes keysAndValuesDo: [:index :meta | - informer value:'Fixing class hierarchy ', (index * 100 // classes size) printString,'%'. - "Check classes before metaclasses (because Metaclass>>isObsolete - checks whether the related class is obsolete)" - meta allInstances do: [:each | self cleanupClassHierarchyFor: each]. - self cleanupClassHierarchyFor: meta. - ]. - Transcript show: 'DONE'.! |
Free forum by Nabble | Edit this page |