The Inbox: Kernel-ct.1356.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Inbox: Kernel-ct.1356.mcz

commits-2
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'.!