Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1513.mcz
==================== Summary ====================
Name: Kernel-mt.1513 Author: mt Time: 12 May 2023, 9:47:22.555412 am UUID: da4aac4d-9677-7a43-ab46-8fe9e08f1fb0 Ancestors: Kernel-eem.1512
Fix issue with categorization of classes. Better support for default category. Do not allow empty class category.
=============== Diff against Kernel-eem.1512 ===============
Item was changed: ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'classifying') ----- classify: element under: heading suppressIfDefault: aBoolean "Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"
| catName catIndex elemIndex realHeading | + realHeading := (heading isEmptyOrNil or: [self isSpecialCategoryName: heading]) - realHeading := (heading isNil or: [self isSpecialCategoryName: heading]) ifTrue: [Default] ifFalse: [heading asSymbol]. (catName := self categoryOfElement: element) = realHeading ifTrue: [^ self]. "done if already under that category"
catName ifNotNil: [ (aBoolean and: [realHeading = Default]) ifTrue: [^ self]. "return if non-Default category already assigned in memory" self basicRemoveElement: element]. "remove if in another category"
(categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].
catIndex := categoryArray indexOf: realHeading. elemIndex := catIndex > 1 ifTrue: [categoryStops at: catIndex - 1] ifFalse: [0]. [(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex) and: [element >= (elementArray at: elemIndex)]] whileTrue.
"elemIndex is now the index for inserting the element. Do the insertion before it." elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1 with: (Array with: element).
"add one to stops for this and later categories" catIndex to: categoryArray size do: [:i | categoryStops at: i put: (categoryStops at: i) + 1].
((categoryArray includes: Default) and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default]. self assertInvariant.!
Item was changed: ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') ----- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe "Define a new class in the given environment. If unsafe is true do not run any validation checks. This facility is provided to implement important system changes." | oldClass instVars classVars copyOfOldClass newClass |
environ := env. instVars := Scanner new scanFieldNames: instVarString. classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].
"Validate the proposed name" unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]]. oldClass := env at: className ifAbsent:[nil]. oldClass isBehavior ifFalse: [oldClass := nil] "Already checked in #validateClassName:" ifTrue: [ copyOfOldClass := oldClass copy. copyOfOldClass superclass addSubclass: copyOfOldClass]. [ | newCategory needNew force organization oldCategory | unsafe ifFalse:[ "Run validation checks so we know that we have a good chance for recompilation" (self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil]. (self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].
"See if we need a new subclass" needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. needNew == nil ifTrue:[^nil]. "some error"
(needNew and:[unsafe not]) ifTrue:[ "Make sure we don't redefine any dangerous classes" (self tooDangerousClasses includes: oldClass name) ifTrue:[ self error: oldClass name, ' cannot be changed'. ]. "Check if the receiver should not be redefined" (oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[ self notify: oldClass name asText allBold, ' should not be redefined. \Proceed to store over it.' withCRs]].
needNew ifTrue:[ "Create the new class" newClass := self newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. newClass == nil ifTrue:[^nil]. "Some error" newClass setName: className. newClass environment: environ. ] ifFalse:[ "Reuse the old class" newClass := oldClass. ].
"Install the class variables and pool dictionaries... " force := (newClass declare: classVarString) | (newClass sharing: poolString).
"... classify ..." + newCategory := category ifNotNil: [category asSymbol]. + organization := environ ifNotNil:[environ organization]. + oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. + organization classify: newClass name under: newCategory suppressIfDefault: true. + newCategory := organization categoryOfElement: newClass name. "if default" - category ifNotNil: [ - newCategory := category asSymbol. - organization := environ ifNotNil:[environ organization]. - oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. - organization classify: newClass name under: newCategory suppressIfDefault: true].
"... recompile ..." newClass := self recompile: force from: oldClass to: newClass mutate: false.
"... export if not yet done ..." (environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[ [environ at: newClass name put: newClass] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. environ flushClassNameCache. ].
newClass doneCompiling. "... notify interested clients ..." oldClass isNil ifTrue: [ SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory. ^ newClass]. newCategory ~= oldCategory ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category] ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.]. ] ensure: [copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass]. Behavior flushObsoleteSubclasses. ]. ^newClass!
squeak-dev@lists.squeakfoundation.org