diff --git a/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.AddClassChange.cls b/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.AddClassChange.cls index a973334cd1..2a5551def8 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.AddClassChange.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.AddClassChange.cls @@ -42,7 +42,7 @@ definingSuperclass ^self class! definition - ^definition ifNil: [definition := details printString]! + ^definition ifNil: [definition := details fullPrintString]! definition: aString definition := aString. diff --git a/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.ClassDetails.cls b/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.ClassDetails.cls index b91d14069e..db7642da9f 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.ClassDetails.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Change Objects/Refactory.Browser.ClassDetails.cls @@ -27,6 +27,9 @@ category: anObject categoryNames ^categoryNames! +classBindingNames + ^self classVariableNames , (self classConstants collect: [:each | each key])! + classCategories ^categoryNames ifNotNil: [categoryNames collect: [:each | ClassCategory name: each]]! @@ -52,6 +55,15 @@ className className: anObject classReference := anObject asQualifiedReference! +className: anObject superclass: aClass categories: aCollection + self className: anObject. + aClass + ifNil: [instanceSpec := 0] + ifNotNil: + [superclassReference := aClass fullyQualifiedReference. + instanceSpec := aClass instanceSpec]. + self categories: aCollection! + classReference ^classReference! @@ -135,6 +147,18 @@ instanceVariableString instanceVariableString: aString instanceVariableNames := $\x20 split: aString! +instSize + "Answer the number of fixed fields (named instance variables) in instances of the receiver." + + "If the instance variables have been changed, the instSize there may be out of date, so calculate it." + + ^superclassReference value instSize + self instanceVariableNames size! + +instSize: anInteger + (anInteger between: 0 and: (self isBytes ifTrue: [0] ifFalse: [Behavior._SizeMask])) + ifFalse: [self error: 'Invalid number of fixed fields']. + instanceSpec := (self instanceSpec maskClear: Behavior._SizeMask) maskSet: anInteger! + isBytes "Answer whether the class described by the receiver has indexable instance variables that are bytes, as opposed to pointers." @@ -215,10 +239,10 @@ kindOfSubclass kindOfSubclass: aString aString = 'subclass:' - ifTrue: [self instanceSpec: Behavior._IsPointersMask] + ifTrue: [self instanceSpec: Behavior._PointersMask] ifFalse: [aString = 'variableSubclass:' - ifTrue: [self instanceSpec: Behavior._IsPointersMask | Behavior._VariableMask] + ifTrue: [self instanceSpec: Behavior._PointersMask | Behavior._VariableMask] ifFalse: [self instanceSpec: Behavior._VariableMask]]! name @@ -348,6 +372,7 @@ categories!accessing!public! ! categories:!accessing!public! ! category:!accessing!public! ! categoryNames!accessing!public! ! +classBindingNames!accessing!public! ! classCategories!accessing!public! ! classConstants!accessing!public! ! classConstants:!accessing!public! ! @@ -356,6 +381,7 @@ classInstanceVariableNames:!accessing!public! ! classInstanceVariableString:!accessing!public! ! className!accessing!public! ! className:!accessing!public! ! +className:superclass:categories:!accessing!initializing!private! ! classReference!accessing!public! ! classVariableNames!accessing!public! ! classVariableNames:!accessing!public! ! @@ -378,6 +404,8 @@ instanceVariableNames!accessing!public! ! instanceVariableNames:!accessing!public! ! instanceVariableString!accessing!public! ! instanceVariableString:!accessing!public! ! +instSize!instance specification-accessing!public! ! +instSize:!accessing!public! ! isBytes!instance specification-testing!public! ! isBytes:!instance specification-accessing!public! ! isInBaseEnvironment!public!testing! ! @@ -418,9 +446,9 @@ unqualifiedName!accessing!public! ! className: aString superclass: aClass categories: aCollection ^self new - className: aString; - superclass: aClass; - categories: aCollection; + className: aString + superclass: aClass + categories: aCollection; yourself! fromClass: aClassDescription diff --git a/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.ParseTreeSearcher.cls b/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.ParseTreeSearcher.cls index b7cce7172e..f98d33f050 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.ParseTreeSearcher.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.ParseTreeSearcher.cls @@ -216,7 +216,7 @@ buildSelectorString: aSelector stream nextPutAll: (keywords at: i); nextPutAll: ' ``@arg'; - nextPutAll: i printString; + print: i; nextPut: $\x20]. ^stream contents! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.RBBindingReference.cls b/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.RBBindingReference.cls index 7d181c10e1..558b1f2bd1 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.RBBindingReference.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Parser/Refactory.Browser.RBBindingReference.cls @@ -46,6 +46,9 @@ realReference referenceInModel: aRBModel ^model == aRBModel ifTrue: [self] ifFalse: [self class model: aRBModel reference: reference]! +species + ^reference species! + valueOfBinding: aVariableBinding ^reference isMeta ifTrue: [aVariableBinding value metaclass] ifFalse: [aVariableBinding value]! ! !Refactory.Browser.RBBindingReference categoriesForMethods! @@ -56,6 +59,7 @@ model:!initializing!private! ! newWrapping:!converting!private! ! realReference!accessing!public! ! referenceInModel:!converting!public! ! +species!comparing!public! ! valueOfBinding:!accessing!private! ! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassRefactoring.cls index 34919f5e16..070227aff5 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassRefactoring.cls @@ -18,6 +18,9 @@ className definitionMessage ^details printString! +details + ^details! + details: aClassDetails subclasses: aCollection details := aClassDetails. details className: (aClassDetails classReference referenceInModel: self model). @@ -26,21 +29,43 @@ details: aClassDetails subclasses: aCollection subclasses := aCollection collect: [:each | self classObjectFor: each]! preconditions - | cond superNotMeta superclass | - #rbFix. "Bodge to allow for nil superclass" - superclass := details superclass. - superNotMeta := superclass isNil - ifTrue: [RBCondition empty] - ifFalse: - [((RBCondition isMetaclass: superclass) errorMacro: 'Superclass must <1?not :>be a metaclass') not]. - cond := subclasses inject: superNotMeta + | cond superclass | + superclass := self superclass. + cond := subclasses inject: self superclassPreconditions into: [:sub :each | sub & ((RBCondition isMetaclass: each) errorMacro: 'Subclass must <1?not :>be a metaclass') not & (RBCondition isImmediateSubclass: each of: superclass)]. - #rbFix. "Dolphin's class categories are named by Strings, not Symbols, and any class can be in multiple categories" ^cond & (RBCondition isValidClassName: self className) - & (RBCondition isStatic: self className in: self model) not! + & (RBCondition isStatic: self className in: self model) not + & ((RBCondition withBlock: [details isPointers or: [details instanceVariableNames isEmpty]]) + errorMacro: ClassBuilder.ErrorBytesAndNamedInstVars; + yourself) + & ((RBCondition withBlock: + [details instanceVariableNames asBag + removeAll: details instanceVariableNames asSet; + isEmpty]) + errorMacro: + [ClassBuilder.ErrorInstVarAlreadyDefined << (details instanceVariableNames asOrderedCollection + removeAll: details instanceVariableNames asSet; + first)]; + yourself) + & ((RBCondition withBlock: + [| varNames | + varNames := details classBindingNames. + varNames asBag + removeAll: varNames asSet; + isEmpty]) + errorMacro: + [| varNames | + varNames := details classBindingNames. + ClassBuilder.ErrorClassVarAlreadyDefined << { + self className. + varNames asSortedCollection + removeAll: varNames asSet; + first + }]; + yourself)! storeOn: aStream aStream @@ -52,6 +77,46 @@ storeOn: aStream store: details; nextPut: $)! +superclass + ^details superclass! + +superclassPreconditions + | superclass cond | + superclass := self superclass. + superclass ifNil: [^RBCondition empty]. + cond := (RBCondition isSubclassable: superclass) + & ((RBCondition isMetaclass: superclass) errorMacro: 'Superclass must <1?not :>be a metaclass') not. + details isBytes + ifTrue: + [cond := cond & ((RBCondition withBlock: [superclass isBytes or: [superclass isVariable not]]) + errorMacro: [ClassBuilder.ErrorByteSubclassOfVariable << superclass]; + yourself) + & ((RBCondition withBlock: [superclass instSize == 0]) + errorMacro: [ClassBuilder.ErrorByteSubclassOfFixed << superclass]; + yourself)] + ifFalse: + [cond := cond & ((RBCondition withBlock: [superclass isPointers]) + errorMacro: [ClassBuilder.ErrorPointerSubclassOfBytes << superclass]; + yourself) + & ((RBCondition withBlock: + ["If the superclass is variable, then the subclass must be too" + superclass isVariable not or: [details isVariable]]) + errorMacro: [ClassBuilder.ErrorFixedSubclassOfVariable << superclass]; + yourself)]. + details instanceVariableNames do: + [:each | + cond := cond & (RBCondition isValidInstanceVariableName: each) + & (RBCondition definesInstanceVariable: each in: superclass) not]. + details classBindingNames do: + [:each | + cond := cond & (RBCondition isValidClassVarName: each) + & (RBCondition definesClassVariable: each in: superclass) not]. + details classInstanceVariableNames do: + [:each | + cond := cond & (RBCondition isValidInstanceVariableName: each) + & (RBCondition definesInstanceVariable: each in: superclass metaclass) not]. + ^cond! + transform #rbFix. "Factor out #definitionMessage in order to permit override in subclass" self model @@ -60,9 +125,12 @@ transform !Refactory.Browser.AddClassRefactoring categoriesForMethods! className!accessing!public! ! definitionMessage!public!transforming! ! +details!accessing!private! ! details:subclasses:!initializing!private! ! -preconditions!public! ! +preconditions!preconditions!public! ! storeOn:!printing!public! ! +superclass!accessing!private! ! +superclassPreconditions!preconditions!private! ! transform!public!transforming! ! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassVariableRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassVariableRefactoring.cls index 457b924c08..756c7658ea 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassVariableRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddClassVariableRefactoring.cls @@ -13,7 +13,7 @@ Refactory.Browser.AddClassVariableRefactoring comment: ''! !Refactory.Browser.AddClassVariableRefactoring methodsFor! preconditions - ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: variableName for: class) + ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: variableName) & (RBCondition hierarchyOf: class definesVariable: variableName asString) not & (RBCondition isStatic: variableName in: self model) not! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddInstanceVariableRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddInstanceVariableRefactoring.cls index 259464bebb..ac07554dfd 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddInstanceVariableRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.AddInstanceVariableRefactoring.cls @@ -13,7 +13,7 @@ Refactory.Browser.AddInstanceVariableRefactoring comment: ''! !Refactory.Browser.AddInstanceVariableRefactoring methodsFor! preconditions - ^(RBCondition isValidInstanceVariableName: variableName for: class) + ^(RBCondition isValidInstanceVariableName: variableName) & (RBCondition hierarchyOf: class definesVariable: variableName) not & (RBCondition isStatic: variableName in: self model) not! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ClassRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ClassRefactoring.cls index 34a486bd38..ba0660a374 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ClassRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ClassRefactoring.cls @@ -20,7 +20,10 @@ className: aString self classReference: (BindingReference fullPathString: aString)! classReference: aBindingReference - className := aBindingReference referenceInModel: self model! + "Accessing the model may lazily create it, which involves setting its name to the displayString of this refactoring. Since the displayString may involve the className, we have a chicken-before-egg problem. To workround this we set the className twice - once to the original binding reference, and then again to the reference in the model." + + className := aBindingReference. + className := className referenceInModel: self model! environment ^className environment! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ExtractToTemporaryRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ExtractToTemporaryRefactoring.cls index b209fb41f8..45b3d67a59 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ExtractToTemporaryRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.ExtractToTemporaryRefactoring.cls @@ -63,8 +63,8 @@ parseTree ^self method parseTreeWithSourceIntervals ifNil: [self refactoringError: 'Could not parse method']! preconditions - ^(RBCondition definesSelector: selector in: class) - & (RBCondition isValidInstanceVariableName: newVariableName for: class) + ^(RBCondition definesSelector: selector in: class) + & (RBCondition isValidInstanceVariableName: newVariableName) & (RBCondition withBlock: [self verifySelectedInterval. self checkVariableName. diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveMethodRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveMethodRefactoring.cls index 45cc0b715e..ae1496d645 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveMethodRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveMethodRefactoring.cls @@ -104,7 +104,7 @@ getAllClassesForGlobalOrClassVariable getArgumentNameForSelf self needsToReplaceSelfReferences ifFalse: [^self]. selfVariableName := self requestSelfArgumentName. - (self checkInstanceVariableName: selfVariableName in: class) + (self checkInstanceVariableName: selfVariableName) ifTrue: [self verifyTemporaryVariableDoesNotOverride ifFalse: diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveVariableDefinitionRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveVariableDefinitionRefactoring.cls index 4636c60f9e..51d701afd0 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveVariableDefinitionRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.MoveVariableDefinitionRefactoring.cls @@ -51,20 +51,16 @@ class: aClass selector: aSelector interval: anInterval ! preconditions - ^(RBCondition definesSelector: selector in: class) + ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [| methodSource | - interval first <= interval last - ifFalse: [self refactoringError: 'Invalid variable name']. + interval first <= interval last ifFalse: [self refactoringError: 'Invalid variable name']. methodSource := class sourceCodeFor: selector. - methodSource size >= interval last - ifFalse: [self refactoringError: 'Invalid range for variable']. - #rbFix. "Allow trailing blanks in the selection" + methodSource size >= interval last ifFalse: [self refactoringError: 'Invalid range for variable']. + #rbFix. "Allow trailing blanks in the selection" name := (methodSource copyFrom: interval first to: interval last) trimBlanks. - (self checkInstanceVariableName: name in: class) - ifFalse: - [self - refactoringError: name , ' does not seem to be a valid variable name.']. + (self checkInstanceVariableName: name) + ifFalse: [self refactoringError: name , ' does not seem to be a valid variable name.']. method := class methodFor: selector. parseTree := method parseTreeWithSourceIntervals. self checkParseTree. diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBAbstractClass.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBAbstractClass.cls index 88f258647d..6ca2cafff5 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBAbstractClass.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBAbstractClass.cls @@ -489,6 +489,9 @@ instanceVariableNames instanceVariableNames: aCollectionOfStrings instanceVariableNames := aCollectionOfStrings! +instSize + ^self allInstanceVariableNames size! + isAbstract self realClass ifNotNil: [:real | real isNonInstantiable ifTrue: [^true]]. (self whichMethodsReferToSymbol: #subclassResponsibility) notEmpty ifTrue: [^true]. @@ -519,13 +522,16 @@ isExternalReference: literalObject in: aCompiledMethod isMeta self subclassResponsibility! +isNonInstantiable + "Answer whether the receiver should not be instantiated, e.g. it is abstract." + + ^self subclassResponsibility! + isPointers - #rbFix. "Added" - ^self nearestRealClass ifNil: [true] ifNotNil: [:class | class isPointers]! + ^self subclassResponsibility! isVariable - #rbFix. "Added" - ^self nearestRealClass ifNil: [true] ifNotNil: [:class | class isVariable]! + ^self subclassResponsibility! localBindingFor: aString "Answer a variable binding for the named variable directly in the scope of this class, i.e. one of its own class variables. If there is no such class variable, then answer nil." @@ -632,6 +638,12 @@ protocolsFor: aSelector realClass ^self subclassResponsibility! +refersToClassVariable: aString + ^(self whichSelectorsReferToClassVariable: aString) notEmpty! + +refersToInstanceVariable: aString + ^(self whichSelectorsReferToInstanceVariable: aString) notEmpty! + removedSelectors ^removedSelectors ?? ##(IdentitySet new beImmutableObject; @@ -914,11 +926,13 @@ inheritsPoolDictionaries!public!testing! ! instanceClass!accessing!public! ! instanceVariableNames!accessing!public! ! instanceVariableNames:!accessing!public! ! +instSize!public! ! isAbstract!public!testing! ! isBytes!instance specification-testing!public! ! isDefined!public!testing! ! isExternalReference:in:!methods-testing!private! ! isMeta!public!testing! ! +isNonInstantiable!instance specification-testing!public! ! isPointers!public!testing! ! isVariable!public!testing! ! localBindingFor:!bindings!public! ! @@ -940,6 +954,8 @@ primaryInstance!accessing!public! ! printOn:!printing!public! ! protocolsFor:!accessing!public! ! realClass!accessing!public! ! +refersToClassVariable:!public!testing! ! +refersToInstanceVariable:!public!testing! ! removedSelectors!accessing!public! ! removeInstanceVariable:!public!variable accessing! ! removeSelector:!methods-removing!public! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBClass.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBClass.cls index 0294b9249e..588365920d 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBClass.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBClass.cls @@ -152,7 +152,7 @@ comment: aString model comment: (comment := aString) in: self! defaultInstanceSpec - ^Behavior._IsPointersMask! + ^Behavior._PointersMask! definition | definitionStream | @@ -233,6 +233,9 @@ instanceSpec ifNil: [self nearestRealClass ifNil: [self defaultInstanceSpec] ifNotNil: [:class | class instanceSpec]]! +instanceSpec: anInteger + instanceSpec := anInteger! + isDefined ^realClass notNil! @@ -250,6 +253,22 @@ isNonInstantiable: aBoolean instanceSpec := self instanceSpec mask: Behavior._NonInstantiableMask set: aBoolean! +isNullTerminated + "Answer true if the instances of the receiver are Null Terminated (that is they include + an extra byte with the value zero at their end, which is not included in the reported size). + Only meaningful for variable byte classes (e.g. String)." + + ^self instanceSpec allMask: Behavior._NullTermMask! + +isPointers + "Answer whether the variables of instances of the receiver contain object pointers (as + opposed to uninterpreted bytes)." + + ^self instanceSpec anyMask: Behavior._PointersMask! + +isVariable + ^self instanceSpec anyMask: Behavior._VariableMask! + kindOfSubclass "Private - Answer a string describing the kind of subclassing method used to create the receiver (part of its definition)." @@ -280,6 +299,7 @@ model: aRBModel existing: aClass (metaclass := RBMetaclass basicNew) instanceClass: self. superclass := LookupSuperclass. comment := LookupComment. + instanceSpec := aClass instanceSpec. ^self! model: aRBModel named: aSymbol @@ -561,11 +581,15 @@ includesEnvironment:!namespaces!public!testing! ! includesNamespace:!public!testing! ! instanceClass!accessing!public! ! instanceSpec!accessing!public! ! +instanceSpec:!public! ! isDefined!public!testing! ! isInBaseEnvironment!public!testing! ! isMeta!public!testing! ! isNonInstantiable!public!testing! ! isNonInstantiable:!instance specification-accessing!public! ! +isNullTerminated!instance specification-testing!public! ! +isPointers!public!testing! ! +isVariable!public!testing! ! kindOfSubclass!class hierarchy-testing!private! ! localScope!accessing!public! ! metaclass!accessing!public! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBCondition.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBCondition.cls index 3477eeb23b..1deb0d713d 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBCondition.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBCondition.cls @@ -57,7 +57,7 @@ canUnderstand: aSelector in: aClass block: [aClass definesMethod: aSelector] errorString: aClass unqualifiedName , ' <1?:does not >understand<1?s:> ' , aSelector printString! -checkClassVarName: aName in: aClass +checkClassVarName: aName | string | aName isString ifFalse: [^false]. string := aName asString. @@ -66,7 +66,7 @@ checkClassVarName: aName in: aClass (string first isUppercase or: [string first == $_]) ifFalse: [^false]. ^Scanner isVariable: string! -checkInstanceVariableName: aName in: aClass +checkInstanceVariableName: aName | string | aName isString ifFalse: [^false]. string := aName asString. @@ -82,7 +82,7 @@ definesClassVariable: aString in: aClass ^self new type: {#definesClassVar. aClass. aString} block: [aClass definesClassVariable: aString] - errorString: [aClass name , ' <1?:does not >define<1?s:> class variable ' + errorString: [aClass name , ' <1?:does not >define<1?s:> class variable/constant ' , aString printString]! definesInstanceVariable: aString in: aClass @@ -301,6 +301,12 @@ isString: aString block: [aString isString] errorString: [aString printString , ' is <1?:not >a string']! +isSubclassable: aClass + ^self new + type: { #isSubclassable. aClass } + block: [aClass isNil or: [(ClassBuilder.Unsubclassable includes: aClass fullyQualifiedReference) not]] + errorString: aClass unqualifiedName , ' is <1?:not >subclassable.'! + isSymbol: aString ^self new type: {#isSymbol. aString} @@ -309,21 +315,21 @@ isSymbol: aString isValidClassName: aString ^self new - type: {#validClassName. aString} + type: { #validClassName. aString } block: [self validClassName: aString] - errorString: [aString printString , ' is <1?:not >a valid class name']! + errorString: [ClassBuilder.ErrorInvalidClassName << aString]! -isValidClassVarName: aString for: aClass +isValidClassVarName: aString ^self new - type: {#validClassVarName. aString. aClass} - block: [self checkClassVarName: aString in: aClass] + type: { #validClassVarName. aString } + block: [self checkClassVarName: aString] errorString: [aString printString , ' is <1?:not >a valid class variable name']! -isValidInstanceVariableName: aString for: aClass +isValidInstanceVariableName: aString ^self new - type: {#validInstVarName. aString. aClass} - block: [self checkInstanceVariableName: aString in: aClass] - errorString: [aString printString , ' is <1?:not >a valid instance variable name']! + type: { #validInstVarName. aString } + block: [self checkInstanceVariableName: aString] + errorString: [ClassBuilder.ErrorInvalidInstVarName << aString]! isValidMethodName: aString ^self new @@ -334,8 +340,8 @@ isValidMethodName: aString isValidTemporaryVariableName: aString for: aClass #rbFix. "Added" ^self new - type: {#validTempVarName. aString. aClass} - block: [self checkInstanceVariableName: aString in: aClass] + type: { #validTempVarName. aString. aClass } + block: [self checkInstanceVariableName: aString] errorString: [aString printString , ' is <1?:not >a valid temporary variable name']! methodDefiningTemporary: aString in: aClass ignore: aBlock @@ -379,10 +385,10 @@ subclassesOf: aClass referToSelector: aSelector errorString: ['<1?:no:a> subclass of ' , aClass unqualifiedName , ' refers to ' , aSelector printString]! -validClassName: aString +validClassName: aString "Class names and class variable names have the same restrictions" - ^self checkClassVarName: aString in: self! + ^self checkClassVarName: aString! withBlock: aBlock ^self new withBlock: aBlock! @@ -393,8 +399,8 @@ withBlock: aBlock errorString: aStringOrValuable errorString: aStringOrValuable! ! !Refactory.Browser.RBCondition class categoriesForMethods! canUnderstand:in:!instance creation!public! ! -checkClassVarName:in:!private!utilities! ! -checkInstanceVariableName:in:!public!utilities! ! +checkClassVarName:!private!utilities! ! +checkInstanceVariableName:!public!utilities! ! checkMethodName:!public!utilities! ! definesClassVariable:in:!instance creation!public! ! definesInstanceVariable:in:!instance creation!public! ! @@ -422,10 +428,11 @@ isMetaclass:!instance creation!public! ! isNamespace:!instance creation!public! ! isStatic:in:!instance creation!public! ! isString:!instance creation!public! ! +isSubclassable:!instance creation!public! ! isSymbol:!instance creation!public! ! isValidClassName:!instance creation!public! ! -isValidClassVarName:for:!instance creation!public! ! -isValidInstanceVariableName:for:!instance creation!public! ! +isValidClassVarName:!instance creation!public! ! +isValidInstanceVariableName:!instance creation!public! ! isValidMethodName:!instance creation!public! ! isValidTemporaryVariableName:for:!instance creation!public! ! methodDefiningTemporary:in:ignore:!private!utilities! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBMetaclass.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBMetaclass.cls index a7efbad814..2b7bdd01ab 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBMetaclass.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBMetaclass.cls @@ -57,6 +57,17 @@ isDefined isMeta ^true! +isNonInstantiable + "Answer whether the receiver should not be instantiated, e.g. it is abstract." + + ^false! + +isPointers + ^true! + +isVariable + ^false! + localScope ^instanceClass! @@ -112,6 +123,9 @@ instanceClass!accessing!public! ! instanceClass:!accessing!initializing!private! ! isDefined!public!testing! ! isMeta!public!testing! ! +isNonInstantiable!instance specification-testing!public! ! +isPointers!public!testing! ! +isVariable!public!testing! ! localScope!accessing!public! ! metaclass!accessing!public! ! model!accessing!public! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBModel.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBModel.cls index 7a9bff63c6..ec50d8fe6d 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBModel.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBModel.cls @@ -183,6 +183,7 @@ createOrUpdateModelClass: anAddClassChange newClass superclass: (self instanceClassNamed: details superclassName). newClass superclass ifNil: [self rootClasses add: newClass]. newClass + instanceSpec: details instanceSpec; instanceVariableNames: details instanceVariableNames; classVariableNames: details classVariableNames; classConstants: details classConstants; diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBNamespaceClass.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBNamespaceClass.cls index 875f5c29e9..72bea3009e 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBNamespaceClass.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RBNamespaceClass.cls @@ -26,7 +26,7 @@ baseEnvironment ^model rootNamespace! defaultInstanceSpec - ^##(Behavior._IsPointersMask | Behavior._NonInstantiableMask)! + ^##(Behavior._PointersMask | Behavior._NonInstantiableMask)! fullName: aString name = aString ifTrue: [^self]. diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.Refactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.Refactoring.cls index 6b90e89a4a..94bbdee5c1 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.Refactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.Refactoring.cls @@ -53,8 +53,8 @@ checkClass: aRBClass selector: aSelector using: aMatcher parseTree notNil ifTrue: [aMatcher executeTree: parseTree]. ^aMatcher answer! -checkInstanceVariableName: aName in: aClass - ^RBCondition checkInstanceVariableName: aName in: aClass! +checkInstanceVariableName: aName + ^RBCondition checkInstanceVariableName: aName! checkMethodName: aName ^RBCondition checkMethodName: aName! @@ -505,7 +505,7 @@ buildVariableReferenceRewriter!private!transforming! ! canReferenceVariable:in:!public!testing! ! changes!accessing!public! ! checkClass:selector:using:!public!support! ! -checkInstanceVariableName:in:!public!utilities! ! +checkInstanceVariableName:!public!utilities! ! checkMethodName:!public!utilities! ! checkPreconditions!preconditions!public! ! checkPreconditions:!preconditions!public! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameClassVariableRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameClassVariableRefactoring.cls index 5fc552d08e..eb3025a0be 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameClassVariableRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameClassVariableRefactoring.cls @@ -13,9 +13,8 @@ Refactory.Browser.RenameClassVariableRefactoring comment: ''! !Refactory.Browser.RenameClassVariableRefactoring methodsFor! preconditions - ^(RBCondition isMetaclass: class) not - & (RBCondition isValidClassVarName: newName asString for: class) - & (RBCondition definesClassVariable: variableName asString in: class) + ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: newName asString) + & (RBCondition definesClassVariable: variableName asString in: class) & (RBCondition hierarchyOf: class definesVariable: newName asString) not & (RBCondition isStatic: newName asString in: self model) not! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameInstanceVariableRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameInstanceVariableRefactoring.cls index 69a15b9f19..dfe7eb49ed 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameInstanceVariableRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.RenameInstanceVariableRefactoring.cls @@ -13,7 +13,7 @@ Refactory.Browser.RenameInstanceVariableRefactoring comment: ''! !Refactory.Browser.RenameInstanceVariableRefactoring methodsFor! preconditions - ^(RBCondition isValidInstanceVariableName: newName for: class) + ^(RBCondition isValidInstanceVariableName: newName) & (RBCondition definesInstanceVariable: variableName in: class) & (RBCondition hierarchyOf: class definesVariable: newName) not & (RBCondition isStatic: newName in: self model) not! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.SplitClassRefactoring.cls b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.SplitClassRefactoring.cls index 5d231e556a..3b0d888e1b 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.SplitClassRefactoring.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Refactorings/Refactory.Browser.SplitClassRefactoring.cls @@ -71,7 +71,7 @@ createReference preconditions ^(RBCondition isValidClassName: newClassName) & (RBCondition isStatic: newClassName in: self model) not - & (RBCondition isValidInstanceVariableName: referenceVariableName for: class) + & (RBCondition isValidInstanceVariableName: referenceVariableName) & (RBCondition hierarchyOf: class definesVariable: referenceVariableName) not & (RBCondition isStatic: referenceVariableName in: self model) not & (RBCondition definesTemporaryVariable: referenceVariableName in: class) not! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.AddClassRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.AddClassRefactoringTest.cls index 61e28ed72e..9fa2ce141b 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.AddClassRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.AddClassRefactoringTest.cls @@ -62,7 +62,7 @@ testAddRootClass refactoring := AddClassRefactoring addClass: 'Refactory.Browser.Tests.FooTest' superclass: nil - subclasses: {ProtoObject} + subclasses: { ProtoObject } categories: #('Refactory-Testing'). self executeRefactoring: refactoring. newClass := refactoring model classNamed: 'Refactory.Browser.Tests.FooTest'. @@ -76,7 +76,8 @@ testAddRootClass self assert: classTest superclass equals: newClass. self assert: (newClass subclasses includes: classTest). self assert: classTest metaclass superclass equals: newClass metaclass. - self assert: (newClass metaclass subclasses includes: classTest metaclass)! + self assert: (newClass metaclass subclasses includes: classTest metaclass). + self assert: newClass kindOfSubclass equals: 'subclass:'! testAddVariableByteClass | refactoring newClass superClass | @@ -116,6 +117,126 @@ testAddVariableClass self assert: newClass kindOfSubclass equals: 'variableSubclass:'. self deny: newClass isNonInstantiable! +testAddVariableSubClass + | refactoring newClass superClass | + refactoring := AddClassRefactoring + addClass: #FooTest + superclass: ByteArray + subclasses: #() + categories: #('Refactory-Testing'). + self executeRefactoring: refactoring. + newClass := refactoring model classNamed: #FooTest. + superClass := refactoring model classFor: ByteArray. + self assert: newClass superclass equals: superClass. + self assert: (superClass subclasses includes: newClass). + self assert: newClass metaclass superclass equals: superClass metaclass. + self assert: (superClass metaclass subclasses includes: newClass metaclass). + self assert: newClass subclasses isEmpty. + self assert: newClass metaclass subclasses isEmpty. + self assert: newClass kindOfSubclass equals: 'variableByteSubclass:'. + self deny: newClass isNonInstantiable! + +testAlreadyExistingClassConstant + | details | + details := ClassDetails + className: 'Core.Foo2' + superclass: FooLintRuleTestData + categories: #(). + details classConstants: { 'Foo1' -> 123 }. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: 'Refactory.Browser.TestData.FooLintRuleTestData defines class variable/constant ''Foo1'''! + +testAlreadyExistingClassVar + | details | + details := ClassDetails + className: 'Core.Foo2' + superclass: FooLintRuleTestData + categories: #(). + details classVariableNames: #('Foo1'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: 'Refactory.Browser.TestData.FooLintRuleTestData defines class variable/constant ''Foo1'''! + +testAlreadyExistingInstanceVar + | details | + details := ClassDetails + className: #Foo + superclass: Core.Association + categories: #(). + details instanceVariableNames: #('key'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: 'Association or a superclass defines an instance variable ''key'''! + +testBadClassConstName + | details | + details := ClassDetails + className: 'Core.Foo' + superclass: self class + categories: #(). + details classConstants: { 'foo' -> 123 }. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: '''foo'' is not a valid class variable name'! + +testBadClassVarName + | details | + details := ClassDetails + className: 'Core.Foo' + superclass: self class + categories: #(). + details classVariableNames: #('Foo' 'bar'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: '''bar'' is not a valid class variable name'! + +testBadInstVarName + | details | + details := ClassDetails + className: #Foo + superclass: self class + categories: #(). + details instanceVariableNames: #('fo-o' 'bar'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorInvalidInstVarName << 'fo-o'! + +testBadName + | badName | + badName := 'Core.Obj@ect'. + self shouldFail: (AddClassRefactoring + addClass: badName + superclass: self class + subclasses: #() + categories: #('Refactory-Testing')) + withMessage: ClassBuilder.ErrorInvalidClassName << badName! + +testBytesWithNamedInstVars + | details | + details := ClassDetails + className: #Foo + superclass: Core.ByteArray + categories: #(). + details instanceVariableNames: #('foo' 'bar'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorBytesAndNamedInstVars! + +testDuplicateClassVarName + | details | + details := ClassDetails + className: #Foo + superclass: self class + categories: #(). + details classVariableNames: #('Foo' 'Bar'). + details classConstants: { 'Bar' -> 123 }. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorClassVarAlreadyDefined << #('Foo' 'Bar')! + +testDuplicateInstVarName + | details | + details := ClassDetails + className: #Foo + superclass: self class + categories: #(). + details instanceVariableNames: #('foo' 'bar' 'foo' 'baz' 'bar'). + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorInstVarAlreadyDefined << 'foo'! + testExistingClassName self shouldFail: (AddClassRefactoring addClass: #'Core.Object' @@ -140,6 +261,100 @@ testExistingVariableName categories: #('Refactory-Testing')) existingVariable: 'Kernel.SourceFiles'! +testIncompatibleByteSubclassOfFixed + | details | + details := ClassDetails + className: #Foo + superclass: Core.Association + categories: #(). + details isBytes: true. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorByteSubclassOfFixed! + +testIncompatibleByteSubclassOfVariable + | details | + details := ClassDetails + className: #Foo + superclass: Core.Array + categories: #(). + details isBytes: true. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorByteSubclassOfVariable! + +testIncompatibleFixedPointerSubclassOfBytes + | details | + details := ClassDetails + className: #Foo + superclass: Core.ByteArray + categories: #(). + details isPointers: true; isVariable: false. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorPointerSubclassOfBytes. +! + +testIncompatibleFixedSubclassOfVariable + | details | + details := ClassDetails + className: #Foo + superclass: Core.Array + categories: #(). + details isVariable: false. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorFixedSubclassOfVariable! + +testIncompatibleVariablePointerSubclassOfBytes + | details | + details := ClassDetails + className: #Foo + superclass: Core.ByteArray + categories: #(). + details isPointers: true; isVariable: true. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorPointerSubclassOfBytes. +! + +testModelAddByteClass + | refactoring newClass superClass subclass details | + superClass := model classNamed: #ArrayedCollection. + subclass := model classFor: ByteArray. + details := subclass details. + details + superclass: superClass; + className: 'Refactory.Browser.Tests.FooTest' asQualifiedReference. + refactoring := AddClassRefactoring + model: model + details: details + subclasses: { subclass }. + self executeRefactoring: refactoring. + newClass := model classNamed: details fullName. + self assert: newClass superclass equals: superClass. + self assert: (superClass subclasses includes: newClass). + self assert: newClass metaclass superclass equals: superClass metaclass. + self assert: (superClass metaclass subclasses includes: newClass metaclass). + self assert: subclass superclass equals: newClass. + self assert: (newClass subclasses includes: subclass). + self assert: subclass metaclass superclass equals: newClass metaclass. + self assert: (newClass metaclass subclasses includes: subclass metaclass). + self assert: newClass isBytes. + self deny: newClass isPointers. + self assert: newClass isVariable. + self deny: newClass isNullTerminated. + self assert: newClass definition equals: 'Core.ArrayedCollection + variableByteSubclass: #''Refactory.Browser.Tests.FooTest'' + instanceVariableNames: '''' + classVariableNames: '''' + imports: #() + classInstanceVariableNames: '''' + classConstants: {}'. + self assert: subclass definition + equals: 'Refactory.Browser.Tests.FooTest + variableByteSubclass: #''Core.ByteArray'' + instanceVariableNames: '''' + classVariableNames: '''' + imports: #() + classInstanceVariableNames: '''' + classConstants: {}'! + testModelAddClass | refactoring newClass superClass subclass | subclass := model classNamed: #Bar. @@ -204,7 +419,15 @@ testSuperclassIsMetaclass superclass: self class class subclasses: #() categories: #('Refactory-Testing')) - withMessage: 'Superclass must not be a metaclass'! ! + withMessage: 'Superclass must not be a metaclass'! + +testUnsubclassable + self shouldFail: (AddClassRefactoring + addClass: #Foo + superclass: SmallInteger + subclasses: #() + categories: #('Refactory-Testing')) + withMessage: ClassBuilder.ErrorUnsubclassable << SmallInteger! ! !Refactory.Browser.Tests.AddClassRefactoringTest categoriesForMethods! setUp!public!set up! ! testAddClass!public!tests! ! @@ -212,14 +435,32 @@ testAddNamespaceClass!public!tests! ! testAddRootClass!public!tests! ! testAddVariableByteClass!public!tests! ! testAddVariableClass!public!tests! ! +testAddVariableSubClass!public!tests! ! +testAlreadyExistingClassConstant!failure tests!public! ! +testAlreadyExistingClassVar!failure tests!public! ! +testAlreadyExistingInstanceVar!failure tests!public! ! +testBadClassConstName!public!tests! ! +testBadClassVarName!public!tests! ! +testBadInstVarName!public!tests! ! +testBadName!failure tests!public! ! +testBytesWithNamedInstVars!public!tests! ! +testDuplicateClassVarName!public!tests! ! +testDuplicateInstVarName!public!tests! ! testExistingClassName!failure tests!public! ! testExistingName!failure tests!public! ! testExistingVariableName!failure tests!public! ! +testIncompatibleByteSubclassOfFixed!public!tests! ! +testIncompatibleByteSubclassOfVariable!public!tests! ! +testIncompatibleFixedPointerSubclassOfBytes!public!tests! ! +testIncompatibleFixedSubclassOfVariable!public!tests! ! +testIncompatibleVariablePointerSubclassOfBytes!public!tests! ! +testModelAddByteClass!public!tests! ! testModelAddClass!public!tests! ! testModelExistingClassName!failure tests!public! ! testModelNonImmediateSubclass!failure tests!public! ! testNonImmediateSubclass!failure tests!public! ! testSubclassIsMetaclass!failure tests!public! ! testSuperclassIsMetaclass!failure tests!public! ! +testUnsubclassable!failure tests!public! ! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest.cls index d0682b1646..bcc22f226d 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest.cls @@ -13,11 +13,13 @@ Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest comment: ''! !Refactory.Browser.Tests.ChildrenToSiblingsRefactoringTest methodsFor! testBadName + | badName | + badName := #'Obje ct'. self shouldFail: (ChildrenToSiblingsRefactoring - name: #'Obje ct' + name: badName class: LintRuleTestData subclasses: {BasicLintRuleTestData. CompositeLintRuleTestData}) - withMessage: '#''Obje ct'' is not a valid class name'! + withMessage: ClassBuilder.ErrorInvalidClassName << badName! testChildToSibling | refactoring class subclass superclass | diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.CreateAccessorsForVariableRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.CreateAccessorsForVariableRefactoringTest.cls index aad3694ed0..48b67c8f8a 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.CreateAccessorsForVariableRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.CreateAccessorsForVariableRefactoringTest.cls @@ -54,17 +54,19 @@ testNewInstanceVariableAccessors equals: (self parseMethod: 'foo1: anObject foo1 := anObject')! testNonExistantName + | errorFormat | + errorFormat := '<1p> does not define class variable/constant <2p>'. self shouldFail: (CreateAccessorsForVariableRefactoring variable: #Foo class: BasicLintRuleTestData classVariable: true) - withMessage: ('<1p> does not define class variable #Foo' << BasicLintRuleTestData); + withMessage: errorFormat << { BasicLintRuleTestData. #Foo }; shouldFail: (CreateAccessorsForVariableRefactoring variable: 'foo' class: BasicLintRuleTestData classVariable: true) - withMessage: ('<1p> does not define class variable ''foo''' << BasicLintRuleTestData)! ! + withMessage: errorFormat << { BasicLintRuleTestData. 'foo' }! ! !Refactory.Browser.Tests.CreateAccessorsForVariableRefactoringTest categoriesForMethods! testExistingInstanceVariableAccessors!public!tests! ! testNewClassVariableAccessors!public!tests! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ExtractToTemporaryRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ExtractToTemporaryRefactoringTest.cls index b5621c2275..0fbc5ac19c 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ExtractToTemporaryRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.ExtractToTemporaryRefactoringTest.cls @@ -35,12 +35,14 @@ testBadInterval withMessage: 'Cannot assign temp from multiple statements'! testBadName + | badName | + badName := 'a sdf'. self shouldFail: (ExtractToTemporaryRefactoring extract: (self convertInterval: (14 to: 23) for: (RefactoryTestDataApp sourceCodeAt: #testMethod)) - to: 'a sdf' + to: badName from: #testMethod in: RefactoryTestDataApp) - withMessage: '''a sdf'' is not a valid instance variable name'! + withMessage: ClassBuilder.ErrorInvalidInstVarName << badName! testExtractToTemporaryForLastStatementInBlock | refactoring | diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.PushDownClassVariableRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.PushDownClassVariableRefactoringTest.cls index 784e221960..39b1fbe103 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.PushDownClassVariableRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.PushDownClassVariableRefactoringTest.cls @@ -19,7 +19,7 @@ testModelNonExistantName model: model variable: #Foo class: (model classNamed: #SomeClass)) - withMessage: 'SomeClass does not define class variable #Foo'! + withMessage: 'SomeClass does not define class variable/constant #Foo'! testModelPushDownToMultipleSubclassesFailure model @@ -103,7 +103,7 @@ testModelRemoveUnusedVariable testNonExistantName self shouldFail: (PushDownClassVariableRefactoring variable: #Foo class: BasicLintRuleTestData) - withMessage: '<1p> does not define class variable #Foo' << BasicLintRuleTestData! + withMessage: '<1p> does not define class variable/constant #Foo' << BasicLintRuleTestData! testPushDownClassVariable | refactoring refDataApp sourceClass targetClass | diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBClassTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBClassTest.cls index edfad97425..dd39b949ac 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBClassTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBClassTest.cls @@ -84,6 +84,39 @@ testClassSubclasses class := model classFor: Class. self assert: class subclasses asArray equals: {objectClass metaclass. model classFor: ProtoObject class}! +testDefineByteClass + | definition | + definition := 'Core.Object + variableByteSubclass: #Bytes + instanceVariableNames: '''' + classVariableNames: ''ClassVariable1'' + imports: #(#{Kernel.OpcodePool}) + classInstanceVariableNames: '''' + classConstants: { ''ClassConstant1'' -> 1.23 }'. + model defineClass: definition. + newClass := model classNamed: #Bytes. + self assert: newClass isVariable. + self deny: newClass isPointers. + self assert: newClass isBytes. + self assert: newClass definition equals: definition. + self assert: newClass instanceSpec equals: Behavior._VariableMask! + +testDefineIndexableClass + | definition | + definition := 'Core.Object + variableSubclass: #VariableClass + instanceVariableNames: ''instanceVariable1 instanceVariable2'' + classVariableNames: ''ClassVariable1'' + imports: #(#{Kernel.OpcodePool}) + classInstanceVariableNames: '''' + classConstants: { ''ClassConstant1'' -> 1.23 }'. + model defineClass: definition. + newClass := model classNamed: #VariableClass. + self assert: newClass isVariable. + self assert: newClass isPointers. + self deny: newClass isBytes. + self assert: newClass definition equals: definition! + testDefinesClassVariable self deny: (objectClass definesClassVariable: #ClassVariable1). self assert: (objectClass definesClassVariable: self objectClassVariable). @@ -174,6 +207,17 @@ testHierarchy self assert: (objectClass withAllSubclasses includes: meta). self assert: (meta withAllSuperclasses includes: objectClass)! +testInstanceSpec + self assert: objectClass instanceSpec equals: Object instanceSpec. + self assert: objectClass isPointers. + self deny: objectClass isBytes. + self deny: objectClass isVariable. + self assert: newClass instanceSpec equals: Object instanceSpec. + self assert: newClass isPointers. + self deny: newClass isBytes. + self deny: newClass isVariable. + self assert: (model classFor: ByteArray) instanceSpec equals: ByteArray instanceSpec! + testLegacyDefinitionString "We don't use the legacy definition string format for RBClasses" @@ -393,6 +437,8 @@ testAllImports!public!unit tests! ! testBindings!public!unit tests! ! testCategories!public!unit tests! ! testClassSubclasses!public!unit tests! ! +testDefineByteClass!public!unit tests! ! +testDefineIndexableClass!public!unit tests! ! testDefinesClassVariable!public!unit tests! ! testDefinesInstanceVariable!public!unit tests! ! testDefinesMethod!public!unit tests! ! @@ -401,6 +447,7 @@ testDefinitionString!public!unit tests! ! testEnvironment!public!unit tests! ! testFullName!public!unit tests! ! testHierarchy!public!unit tests! ! +testInstanceSpec!public!unit tests! ! testLegacyDefinitionString!public!unit tests! ! testLocalBindingFor!public!unit tests! ! testMethodsReferencingExternals1!public! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBConditionTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBConditionTest.cls index e94329411a..967a9367e3 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBConditionTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RBConditionTest.cls @@ -88,10 +88,21 @@ testIsGlobalIn self assert: subject check description: subject errorString. "UI.Bitmap is bindable, but as an import so there is no actual UI.Bitmap 'global'" subject := RBCondition isStatic: 'UI.Bitmap' in: model. - self deny: subject check description: (subject errorStringFor: true)! ! + self deny: subject check description: (subject errorStringFor: true)! + +testIsSubclassable + | subject result | + subject := RBCondition isSubclassable: Character. + result := subject validate. + self deny: result value. + self assert: result hint messageText equals: ClassBuilder.ErrorUnsubclassable << Character. + subject := RBCondition isSubclassable: Object. + self assert: subject check. + self assert: (subject errorStringFor: true) equals: 'Object is subclassable.'! ! !Refactory.Browser.Tests.RBConditionTest categoriesForMethods! testConditions!public!tests! ! testIsEmptyClass!public!tests! ! testIsGlobalIn!public!tests! ! +testIsSubclassable!public!tests! ! ! diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RemoveClassVariableRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RemoveClassVariableRefactoringTest.cls index 0b08e91ae6..41530931ea 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RemoveClassVariableRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RemoveClassVariableRefactoringTest.cls @@ -18,12 +18,12 @@ setRemoveReferencedVariableOption: refactoring toAnswer: aBoolean testAttemptToRemoveClass self shouldFail: (RemoveClassVariableRefactoring variable: self class name class: self class environment) - withMessage: '<1d> does not define class variable #<2s>' << {self class environment. self class name}! + withMessage: '<1d> does not define class variable/constant #<2s>' << {self class environment. self class name}! testNonExistantName self shouldFail: (RemoveClassVariableRefactoring variable: #RecursiveSelfRule1 class: TransformationRuleTestData) - withMessage: '<1p> does not define class variable #RecursiveSelfRule1' << TransformationRuleTestData! + withMessage: '<1p> does not define class variable/constant #RecursiveSelfRule1' << TransformationRuleTestData! testReferencedVariable | refactoring class | diff --git a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RenameClassRefactoringTest.cls b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RenameClassRefactoringTest.cls index a36d921e5e..fdef7487e2 100644 --- a/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RenameClassRefactoringTest.cls +++ b/Core/Contributions/Refactory/Refactoring Browser/Tests/Refactory.Browser.Tests.RenameClassRefactoringTest.cls @@ -25,7 +25,7 @@ testBadName shouldFail: (RenameClassRefactoring rename: LintRuleTestData to: existing) existingVariable: existing; shouldFail: (RenameClassRefactoring rename: LintRuleTestData to: #'Ob ject') - withMessage: '''Smalltalk.Ob ject'' is not a valid class name'! + withMessage: ClassBuilder.ErrorInvalidClassName << 'Smalltalk.Ob ject'! testExistingClassVariableName | refactoring subclass | diff --git a/Core/Object Arts/Dolphin/Base/Core.ClassDescription.cls b/Core/Object Arts/Dolphin/Base/Core.ClassDescription.cls index 0473f2b04f..7f60eb5d04 100644 --- a/Core/Object Arts/Dolphin/Base/Core.ClassDescription.cls +++ b/Core/Object Arts/Dolphin/Base/Core.ClassDescription.cls @@ -72,9 +72,16 @@ addProtocol: protocol protocols add: protName. self allSubclassesDo: [:q | q removeProtocol: protName ifAbsent: nil]! +allClassVariableNames + "Answer a of the names of the receiver's and the receiver's superclasses' class variables (excluding constants)." + + | answer | + answer := Set new. + self withAllSuperclassesDo: [:c | answer addAll: c classVariableNames]. + ^answer! + allClassVarNames - "Answer a of the names of the receiver's and the - receiver's superclasses' class variables." + "Answer a of the names of the receiver's and the receiver's superclasses' static variables." | answer | answer := Set new. @@ -1063,6 +1070,7 @@ withAllSubclassesDo: aMonadicValuable absoluteReference!accessing!namespaces!public! ! addInstVarName:!class hierarchy-mutating!instance variables!public! ! addProtocol:!private!protocols! ! +allClassVariableNames!class variables!public! ! allClassVarNames!class variables!public! ! allGettersDo:!accessing!private! ! allInstances!instances!public! ! diff --git a/Core/Object Arts/Dolphin/Base/DolphinClasses.st b/Core/Object Arts/Dolphin/Base/DolphinClasses.st index dbdca980e2..c8ed1e2d2f 100644 --- a/Core/Object Arts/Dolphin/Base/DolphinClasses.st +++ b/Core/Object Arts/Dolphin/Base/DolphinClasses.st @@ -2444,6 +2444,8 @@ Core.Object -> 'A byte subclass may not derive from a class containing indexed instance variables'. 'ErrorChangeMetaclassSuperclass' -> 'It is invalid to directly change the superclass of a metaclass.'. + 'ErrorClassVarAlreadyDefined' + -> 'Proposed class variable <1s>.<2s> is multiply defined.'. 'ErrorFixedInitialLayout' -> 'New inst vars must come after those already in <1p>'. 'ErrorFixedLayout' -> 'You must not change the instance variable layout of <1p>'. 'ErrorFixedSubclassOfVariable' @@ -2494,7 +2496,7 @@ Core.Object 'IgnoreInstsMask' -> 16r2. 'QuietMask' -> 16r4. 'RecompileMask' -> 16r1. - 'Unsubclassable' -> (IdentitySet withAll: { Character. SmallInteger }) + 'Unsubclassable' -> (Set withAll: #(#{Core.Character} #{Core.SmallInteger})) }! Core.Object subclass: #'Core.Collection' diff --git a/Core/Object Arts/Dolphin/Base/Kernel.BindingReferenceWrapper.cls b/Core/Object Arts/Dolphin/Base/Kernel.BindingReferenceWrapper.cls index 76f55a8d95..58b7beadd0 100644 --- a/Core/Object Arts/Dolphin/Base/Kernel.BindingReferenceWrapper.cls +++ b/Core/Object Arts/Dolphin/Base/Kernel.BindingReferenceWrapper.cls @@ -70,7 +70,7 @@ environmentName hash "Answer the hash value for the receiver." - ^reference hash bitXor: 1! + ^reference hash! home "Answer the 'namespace context' for this binding reference." diff --git a/Core/Object Arts/Dolphin/Base/Kernel.ClassBuilder.cls b/Core/Object Arts/Dolphin/Base/Kernel.ClassBuilder.cls index ead808bf3e..2c1ba07a02 100644 --- a/Core/Object Arts/Dolphin/Base/Kernel.ClassBuilder.cls +++ b/Core/Object Arts/Dolphin/Base/Kernel.ClassBuilder.cls @@ -16,6 +16,8 @@ Core.Object -> 'A byte subclass may not derive from a class containing indexed instance variables'. 'ErrorChangeMetaclassSuperclass' -> 'It is invalid to directly change the superclass of a metaclass.'. + 'ErrorClassVarAlreadyDefined' + -> 'Proposed class variable <1s>.<2s> is multiply defined.'. 'ErrorFixedInitialLayout' -> 'New inst vars must come after those already in <1p>'. 'ErrorFixedLayout' -> 'You must not change the instance variable layout of <1p>'. 'ErrorFixedSubclassOfVariable' @@ -66,7 +68,7 @@ Core.Object 'IgnoreInstsMask' -> 16r2. 'QuietMask' -> 16r4. 'RecompileMask' -> 16r1. - 'Unsubclassable' -> (IdentitySet withAll: { Character. SmallInteger }) + 'Unsubclassable' -> (Set withAll: #(#{Core.Character} #{Core.SmallInteger})) }! Kernel.ClassBuilder guid: (Core.GUID fromString: '{87b4c461-026e-11d3-9fd7-00a0cc3e4a32}')! Kernel.ClassBuilder comment: ''! @@ -923,17 +925,15 @@ validateClass: classNameString varName: varNameString inherited: aCollection (self class isValidIdentifier: varNameString) ifFalse: [self error: 'Proposed class variable <2s> of <1s> is invalid as a local identifier.' - << {classNameString. varNameString}]. + << { classNameString. varNameString }]. (aCollection includes: varNameString) - ifTrue: - [self - error: 'Proposed class variable <1s>.<2s> is multiply defined.' << {classNameString. varNameString}]. + ifTrue: [self error: ErrorClassVarAlreadyDefined << { classNameString. varNameString }]. first := varNameString first. (first isUppercase or: [first == $_]) ifTrue: [^self]. Warning new isSuppressible: true; signal: 'Proposed class variable <2p> of <1s> should start with an uppercase letter.' - << {classNameString. varNameString}! + << { classNameString. varNameString }! validateClassForRename "Private - Ensure that we are permitted to rename the class." @@ -1267,7 +1267,7 @@ validateSuperclassIsSubclassable superclass notNil ifTrue: - [(superclass class isMeta not or: [Unsubclassable includes: superclass]) + [(superclass class isMeta not or: [Unsubclassable includes: superclass fullyQualifiedReference]) ifTrue: [self error: ErrorUnsubclassable << superclass]]! ! !Kernel.ClassBuilder categoriesForMethods! allInstVarNamesOf:!helpers!private! ! diff --git a/Core/Object Arts/Dolphin/Base/Kernel.MetaBindingReference.cls b/Core/Object Arts/Dolphin/Base/Kernel.MetaBindingReference.cls index b921f73503..20d0f62f5e 100644 --- a/Core/Object Arts/Dolphin/Base/Kernel.MetaBindingReference.cls +++ b/Core/Object Arts/Dolphin/Base/Kernel.MetaBindingReference.cls @@ -28,6 +28,11 @@ displayOn: aPuttableStream space; nextPutAll: #class! +hash + "Answer the hash value for the receiver." + + ^reference hash bitXor: 1! + instance "Answer a `BindingReference` that resolves to the value of the binding with the receiver's path." @@ -58,6 +63,7 @@ valueOfBinding: aVariableBinding !Kernel.MetaBindingReference categoriesForMethods! asString!converting!public! ! displayOn:!displaying!public! ! +hash!comparing!public! ! instance!accessing!public! ! isMeta!public!testing! ! meta!converting!public! ! diff --git a/Core/Object Arts/Dolphin/Base/Tests/Kernel.Tests.MetaBindingReferenceTest.cls b/Core/Object Arts/Dolphin/Base/Tests/Kernel.Tests.MetaBindingReferenceTest.cls index a457c977e3..3a290acac9 100644 --- a/Core/Object Arts/Dolphin/Base/Tests/Kernel.Tests.MetaBindingReferenceTest.cls +++ b/Core/Object Arts/Dolphin/Base/Tests/Kernel.Tests.MetaBindingReferenceTest.cls @@ -24,8 +24,9 @@ testEqualityOfMetaAndInstance "Meta and instance references should never be equal, whether or not the path is the same." self deny: #{Core.Object class} equals: #{Core.Object}. - self deny: #{_.Object class} equals: #{_.Object} -! + self deny: #{Core.Object} equals: #{Core.Object class}. + self deny: #{Core.Object} hash equals: #{Core.Object class} hash. + self deny: #{_.Object class} equals: #{_.Object}! testInstance | inst subject | diff --git a/Core/Object Arts/Dolphin/IDE/Base/Tools.CreateSubclassDialog.cls b/Core/Object Arts/Dolphin/IDE/Base/Tools.CreateSubclassDialog.cls index 2c8acedc2f..fbce9f4f71 100644 --- a/Core/Object Arts/Dolphin/IDE/Base/Tools.CreateSubclassDialog.cls +++ b/Core/Object Arts/Dolphin/IDE/Base/Tools.CreateSubclassDialog.cls @@ -301,8 +301,8 @@ updatePackage packagesPresenter selection: package]! validateModel - ^self validateSuperclass - ifNil: [self validatePackage ifNil: [self validateName ifNil: [ValidationResult new]]]! + ^self validateName + ifNil: [self validateSuperclass ifNil: [self validatePackage ifNil: [ValidationResult new]]]! validateName | result unqualifiedName namespace | @@ -342,45 +342,18 @@ validatePackage yourself]! validateSuperclass - | superclass aValidationResult | - superclass := self superclass. + ^self validateSuperclass: self classDetails! + +validateSuperclass: aClassDetails + | result superclass | + superclass := aClassDetails superclass. superclass ifNil: [^nil]. - aValidationResult := ValidationResult new - presenter: superclassPresenter; - caption: 'Incompatible superclass'; - yourself. - (ClassBuilder.Unsubclassable includes: superclass) - ifTrue: - [^aValidationResult - errorMessage: ClassBuilder.ErrorUnsubclassable << superclass; - yourself]. - self isBytes - ifTrue: - [superclass isPointers - ifTrue: - [superclass instSize > 0 - ifTrue: - [^aValidationResult - errorMessage: ClassBuilder.ErrorByteSubclassOfFixed << superclass; - yourself]. - superclass isVariable - ifTrue: - [^aValidationResult - errorMessage: ClassBuilder.ErrorByteSubclassOfVariable << superclass; - yourself]]. - ^nil]. - "Validate pointer class" - superclass isBytes - ifTrue: - [^aValidationResult - errorMessage: ClassBuilder.ErrorPointerSubclassOfBytes << superclass; - yourself]. - (superclass isVariable and: [self isVariable not]) - ifTrue: - [^aValidationResult - errorMessage: ClassBuilder.ErrorFixedSubclassOfVariable << superclass; - yourself]. - ^nil! ! + result := self systemModel validateCreateSubclass: aClassDetails. + result value ifTrue: [^nil]. + ^result + presenter: superclassPresenter; + caption: 'Incompatible superclass'; + yourself! ! !Tools.CreateSubclassDialog categoriesForMethods! canApply!private!testing! ! canChangeAttributes!public!testing! ! @@ -429,7 +402,8 @@ updatePackage!private!updating! ! validateModel!private!validation! ! validateName!private!validation! ! validatePackage!private!validation! ! -validateSuperclass!private!testing! ! +validateSuperclass!private!validation! ! +validateSuperclass:!private!testing! ! ! !Tools.CreateSubclassDialog class methodsFor! diff --git a/Core/Object Arts/Dolphin/IDE/Base/Tools.SmalltalkSystem.cls b/Core/Object Arts/Dolphin/IDE/Base/Tools.SmalltalkSystem.cls index 2e81e938bc..c16ba90510 100644 --- a/Core/Object Arts/Dolphin/IDE/Base/Tools.SmalltalkSystem.cls +++ b/Core/Object Arts/Dolphin/IDE/Base/Tools.SmalltalkSystem.cls @@ -4171,6 +4171,43 @@ upgradeAllResourcesReferencingClassNamed: aSymbol userPreferencesIcon ^Icon fromId: 'SMALLTALKOPTIONSFOLDER.ICO'! +validateCreateSubclass: aClassDetails + | result superclass | + result := ValidationResult new. + superclass := aClassDetails superclass. + (ClassBuilder.Unsubclassable includes: superclass fullyQualifiedReference) + ifTrue: + [^result + errorMessage: ClassBuilder.ErrorUnsubclassable << superclass; + yourself]. + aClassDetails isBytes + ifTrue: + [superclass isPointers + ifTrue: + [superclass instSize > 0 + ifTrue: + [^result + errorMessage: ClassBuilder.ErrorByteSubclassOfFixed << superclass; + yourself]. + superclass isVariable + ifTrue: + [^result + errorMessage: ClassBuilder.ErrorByteSubclassOfVariable << superclass; + yourself]]. + ^result]. + "Validate pointer class" + superclass isBytes + ifTrue: + [^result + errorMessage: ClassBuilder.ErrorPointerSubclassOfBytes << superclass; + yourself]. + (superclass isVariable and: [aClassDetails isVariable not]) + ifTrue: + [^result + errorMessage: ClassBuilder.ErrorFixedSubclassOfVariable << superclass; + yourself]. + ^result! + validateNewClassVarName: aString for: aClass ^ValidationResult value: ((ClassBuilder isValidClassName: aString) and: @@ -4756,6 +4793,7 @@ uninitialize!class hierarchy-removing!private! ! unregisterTool:!accessing!public! ! upgradeAllResourcesReferencingClassNamed:!helpers!public! ! userPreferencesIcon!initializing!private! ! +validateCreateSubclass:!helpers!private!refactoring! ! validateNewClassVarName:for:!helpers!private!refactoring! ! validateNewInstanceVariableName:for:!enquiries!helpers!private! ! validateRenameInstVar:to:in:!helpers!private! ! diff --git a/Core/Object Arts/Dolphin/IDE/Professional/Dolphin Refactoring Browser.pax b/Core/Object Arts/Dolphin/IDE/Professional/Dolphin Refactoring Browser.pax index ee512ddf32..265011ba99 100644 --- a/Core/Object Arts/Dolphin/IDE/Professional/Dolphin Refactoring Browser.pax +++ b/Core/Object Arts/Dolphin/IDE/Professional/Dolphin Refactoring Browser.pax @@ -467,7 +467,7 @@ Refactory.Browser.RBMethodName classConstants: {}! Refactory.Browser.ClassRefactoring subclass: #'Refactory.Browser.CopyClassRefactoring' - instanceVariableNames: 'newName class superclass' + instanceVariableNames: 'newName addClass commonSuperclass superclass' classVariableNames: '' imports: #() classInstanceVariableNames: '' diff --git a/Core/Object Arts/Dolphin/IDE/Professional/Refactory.Browser.CopyClassRefactoring.cls b/Core/Object Arts/Dolphin/IDE/Professional/Refactory.Browser.CopyClassRefactoring.cls index 98575427c0..675206f866 100644 --- a/Core/Object Arts/Dolphin/IDE/Professional/Refactory.Browser.CopyClassRefactoring.cls +++ b/Core/Object Arts/Dolphin/IDE/Professional/Refactory.Browser.CopyClassRefactoring.cls @@ -2,7 +2,7 @@ Refactory.Browser.ClassRefactoring subclass: #'Refactory.Browser.CopyClassRefactoring' - instanceVariableNames: 'newName class superclass' + instanceVariableNames: 'newName addClass commonSuperclass superclass' classVariableNames: '' imports: #() classInstanceVariableNames: '' @@ -12,58 +12,68 @@ Refactory.Browser.CopyClassRefactoring comment: ''! !Refactory.Browser.CopyClassRefactoring categoriesForClass!Refactory-Refactorings! ! !Refactory.Browser.CopyClassRefactoring methodsFor! -className: aName newName: aNewName superclass: aClass - self className: aName. - "If the new name is unqualified, preserve the original namespace of the class." +buildClassDetails: superClass + | details progenitor classVarNames instVarNames classConstants classInstVarNames | + details := (ClassDetails fromClass: self progenitor) + superclass: superClass; + className: newName; + yourself. + instVarNames := Array writeStream. + classVarNames := Array writeStream. + classInstVarNames := Array writeStream. + classConstants := Array writeStream. + progenitor := self progenitor. + "Copy over any superclass variables that might be referenced" + (progenitor allSuperclasses upTo: self commonSuperclass) reverseDo: + [:each | + instVarNames + nextPutAll: (each instanceVariableNames select: [:iv | progenitor refersToInstanceVariable: iv]). + classVarNames nextPutAll: (each classVariableNames + select: [:cv | (progenitor refersToClassVariable: cv) or: [progenitor metaclass refersToClassVariable: cv]]). + classConstants + nextPutAll: (each classConstants select: [:cc | progenitor refersToClassVariable: cc key]). + classInstVarNames nextPutAll: (each metaclass instanceVariableNames + select: [:iv | progenitor metaclass refersToInstanceVariable: iv])]. + "Copy over the directly defined variables, whether referenced or not" + instVarNames nextPutAll: progenitor instanceVariableNames. + classVarNames nextPutAll: progenitor classVariableNames. + classConstants nextPutAll: progenitor classConstants. + classInstVarNames nextPutAll: progenitor metaclass instanceVariableNames. + details + instanceVariableNames: instVarNames grabContents; + classVariableNames: classVarNames grabContents; + classConstants: classConstants grabContents; + classInstanceVariableNames: classInstVarNames grabContents. + ^details! + +className: progenitorName newName: aNewName superclass: aClass + | details classRef | + "We need to set the superclass name and new name before doing anything that might lazily instantiate the model, as these are part of the displayString used to generate a model name" + classRef := BindingReference fullPathString: progenitorName. newName := ((BindingReference isQualifiedName: aNewName) ifTrue: [aNewName] ifFalse: [| parts | - parts := className path copy. + parts := classRef path copy. parts at: parts size put: aNewName. BindingReference.PathSeparator join: parts]) asSymbol. - class := self model classNamed: aName. + self classReference: classRef. superclass := self classObjectFor: aClass. - ^self! - -copyClass - | details | - details := ClassDetails fromClass: class. - details - superclass: superclass; - className: newName. - self performComponentRefactoring: (AddClassRefactoring + details := self buildClassDetails: superclass. + addClass := AddClassRefactoring model: self model details: details - subclasses: #()). - ^self model classNamed: newName! - -copyClassVarsTo: clone - (class allClassVariableNames difference: superclass allClassVariableNames) do: - [:each | - self performComponentRefactoring: (AddClassVariableRefactoring - model: self model - variable: each - class: clone)]! + subclasses: #(). + ^self! -copyImportsTo: clone - class allImports do: - [:each | - (clone importsNamespace: each) - ifFalse: - [self performComponentRefactoring: (AddImportRefactoring - model: self model - addImport: each - to: clone)]]! +cloneClass + self performComponentRefactoring: addClass. + ^self model classNamed: self newName! -copyInstVarsTo: clone - (class allInstanceVariableNames difference: superclass allInstanceVariableNames) do: - [:each | - self performComponentRefactoring: (AddInstanceVariableRefactoring - model: self model - variable: each - class: clone)]! +commonSuperclass + ^superclass + ifNotNil: [:targetSuper | (targetSuper withAllSuperclasses intersection: self progenitor allSuperclasses) lookup: 1]! copyMethodsFrom: aRBAbstractClass to: cloneClass aRBAbstractClass selectors do: @@ -80,54 +90,46 @@ displayOn: aPuttableStream nextPutAll: 'Clone class '; display: className; nextPutAll: ' as '; - display: newName! + display: self newName! + +newName + ^newName! preconditions - ^(RBCondition withBlock: [class notNil and: [class isMeta not]] - errorString: [self className , ' is <1?:not >a valid class name']) & (superclass isNil - ifTrue: [RBCondition empty] - ifFalse: - [((RBCondition isMetaclass: superclass) errorMacro: 'Superclass must <1?:not >be a metaclass') not]) - & (RBCondition isValidClassName: newName) & (RBCondition isStatic: newName in: self model) not! - -storeOn: aStream - aStream nextPut: $(. - self class storeOn: aStream. - aStream nextPutAll: ' clone: '. - class storeOn: aStream. - aStream - nextPutAll: ' as: #'; - nextPutAll: newName; - nextPutAll: ' superclass: '. - superclass storeOn: aStream. - aStream nextPut: $)! + ^addClass preconditions! -superclass - ^superclass! +progenitor + ^className value! -superclass: aClass - superclass := self classObjectFor: aClass.! +storeOn: aStream + aStream + nextPut: $(; + store: self class; + nextPutAll: ' clone: '; + store: self progenitor; + nextPutAll: ' as: '; + store: self newName; + nextPutAll: ' superclass: '; + store: superclass; + nextPut: $)! transform - | clone | - clone := self copyClass. - self copyInstVarsTo: clone. - self copyClassVarsTo: clone. - self copyImportsTo: clone. - self copyMethodsFrom: class to: clone. - self copyMethodsFrom: class metaclass to: clone metaclass! ! + | clone source | + clone := self cloneClass. + source := self progenitor. + self copyMethodsFrom: source to: clone. + self copyMethodsFrom: source metaclass to: clone metaclass! ! !Refactory.Browser.CopyClassRefactoring categoriesForMethods! +buildClassDetails:!initializing!private! ! className:newName:superclass:!initializing!private! ! -copyClass!private!transforming! ! -copyClassVarsTo:!private!transforming! ! -copyImportsTo:!private!transforming! ! -copyInstVarsTo:!private!transforming! ! +cloneClass!private!transforming! ! +commonSuperclass!accessing!private! ! copyMethodsFrom:to:!private!transforming! ! displayOn:!displaying!public! ! +newName!public!transforming! ! preconditions!preconditions!public! ! +progenitor!accessing!private! ! storeOn:!printing!public! ! -superclass!accessing!private! ! -superclass:!accessing!private! ! transform!public!transforming! ! ! diff --git a/Core/Object Arts/Dolphin/IDE/Professional/Tests/Dolphin Professional Tools Tests.pax b/Core/Object Arts/Dolphin/IDE/Professional/Tests/Dolphin Professional Tools Tests.pax index f9d6e37375..f52927e274 100644 --- a/Core/Object Arts/Dolphin/IDE/Professional/Tests/Dolphin Professional Tools Tests.pax +++ b/Core/Object Arts/Dolphin/IDE/Professional/Tests/Dolphin Professional Tools Tests.pax @@ -5,6 +5,7 @@ package paxVersion: 2.1; package setClassNames: #( + #{Refactory.Browser.Tests.CopyClassRefactoringTest} #{Refactory.Browser.Tests.RenameMethodReferencesTransformationTest} #{Refactory.Browser.Tests.RewriteTestCase} #{Tools.Tests.DisassemblerTest} @@ -17,6 +18,7 @@ package setPrerequisites: #( '..\..\..\Base\Tests\Dolphin Base Tests' '..\Dolphin Professional Tools' '..\Dolphin Refactoring Browser' + '..\..\..\..\..\Contributions\Refactory\Refactoring Browser\Change Objects\RBChangeObjects' '..\..\..\..\..\Contributions\Refactory\Refactoring Browser\Environments\RBEnvironments' '..\..\..\..\..\Contributions\Refactory\Refactoring Browser\Refactorings\RBRefactorings' '..\..\..\..\..\Contributions\Refactory\Refactoring Browser\SmallLint\RBSmallLint' @@ -43,6 +45,13 @@ Core.Tests.DolphinTest imports: #() classInstanceVariableNames: '' classConstants: {}! +Refactory.Browser.Tests.RefactoringTest + subclass: #'Refactory.Browser.Tests.CopyClassRefactoringTest' + instanceVariableNames: '' + classVariableNames: '' + imports: #() + classInstanceVariableNames: '' + classConstants: {}! Refactory.Browser.Tests.RefactoringTest subclass: #'Refactory.Browser.Tests.RenameMethodReferencesTransformationTest' instanceVariableNames: '' diff --git a/Core/Object Arts/Dolphin/IDE/Professional/Tests/Refactory.Browser.Tests.CopyClassRefactoringTest.cls b/Core/Object Arts/Dolphin/IDE/Professional/Tests/Refactory.Browser.Tests.CopyClassRefactoringTest.cls new file mode 100644 index 0000000000..0040ba00a9 --- /dev/null +++ b/Core/Object Arts/Dolphin/IDE/Professional/Tests/Refactory.Browser.Tests.CopyClassRefactoringTest.cls @@ -0,0 +1,213 @@ +"Filed out from Dolphin Smalltalk"! + +Refactory.Browser.Tests.RefactoringTest + subclass: #'Refactory.Browser.Tests.CopyClassRefactoringTest' + instanceVariableNames: '' + classVariableNames: '' + imports: #() + classInstanceVariableNames: '' + classConstants: {}! +Refactory.Browser.Tests.CopyClassRefactoringTest guid: (Core.GUID fromString: '{20137dd7-fe4e-4c82-91c5-d4c2946c6465}')! +Refactory.Browser.Tests.CopyClassRefactoringTest comment: ''! +!Refactory.Browser.Tests.CopyClassRefactoringTest methodsFor! + +testAlreadyExistingInstanceVar + self shouldFail: (CopyClassRefactoring + clone: LookupTable + as: 'Core.Foo' + superclass: RunArray) + withMessage: 'RunArray or a superclass defines an instance variable ''values'''! + +testBadName + self shouldFail: (CopyClassRefactoring + clone: self class + as: #'Obje@ct' + superclass: Object) + withMessage: ClassBuilder.ErrorInvalidClassName << 'Refactory.Browser.Tests.Obje@ct'! + +testCopyByteClass + | refactoring newClass | + refactoring := CopyClassRefactoring + clone: ByteArray + as: #'Refactory.Browser.TestData.Foo' + superclass: Object. + self executeRefactoring: refactoring. + newClass := refactoring model classNamed: #'Refactory.Browser.TestData.Foo'. + self assert: newClass definition + equals: 'Core.Object + variableByteSubclass: #''Refactory.Browser.TestData.Foo'' + instanceVariableNames: '''' + classVariableNames: '''' + imports: #() + classInstanceVariableNames: '''' + classConstants: {}'. + self verify: newClass isCopyOf: ByteArray! + +testCopyClass + | superclass progenitor refactoring newClass | + superclass := model classNamed: 'Core.Model'. + progenitor := model classNamed: 'Refactory.Browser.Tests.SubclassOfClassToRename'. + refactoring := CopyClassRefactoring + model: model + clone: progenitor + as: #Foo + superclass: superclass. + self assert: refactoring storeString + equals: '(Refactory.Browser.CopyClassRefactoring clone: <1p> as: #''Refactory.Browser.Tests.Foo'' superclass: <2s>)' + << { progenitor. superclass fullName }. + self assert: refactoring displayString + equals: 'Clone class <1p> as Refactory.Browser.Tests.Foo' << progenitor. + self executeRefactoring: refactoring. + newClass := refactoring model classNamed: #'Refactory.Browser.Tests.Foo'. + self assert: newClass definition + equals: 'Core.Model + subclass: #''Refactory.Browser.Tests.Foo'' + instanceVariableNames: ''rewriteRule1'' + classVariableNames: ''ClassVar1 SubclassVar1'' + imports: #(#{Refactory.Browser.Tests.ClassToRename private}) + classInstanceVariableNames: '''' + classConstants: { ''ClassConst1'' -> 16r1 }'. + self verify: newClass isCopyOf: progenitor! + +testCopyIndexedClass + | refactoring newClass | + refactoring := CopyClassRefactoring + clone: LookupTable + as: #Foo + superclass: Object. + self executeRefactoring: refactoring. + "self verify: newClass isCopyOf: LookupTable"! + +testDuplicateClassVarName + | superclass refactoring | + superclass := model classNamed: 'Refactory.Browser.Tests.SubclassOfClassToRename'. + refactoring := CopyClassRefactoring + model: model + clone: RefactoryTestDataApp + as: #Foo + superclass: superclass. + self assert: refactoring storeString + equals: '(Refactory.Browser.CopyClassRefactoring clone: <1p> as: #''Refactory.Browser.TestData.Foo'' superclass: <2p>)' + << { RefactoryTestDataApp. superclass }. + self assert: refactoring displayString + equals: 'Clone class <1p> as Refactory.Browser.TestData.Foo' << RefactoryTestDataApp. + self shouldFail: refactoring + withMessage: 'Refactory.Browser.Tests.SubclassOfClassToRename defines class variable/constant ''ClassVar1'''! + +testExistingClassName + self shouldFail: (CopyClassRefactoring + clone: self class + as: #RefactoringTest + superclass: Object) + existingVariable: 'Refactory.Browser.Tests.RefactoringTest'! + +testExistingVariableName + self shouldFail: (CopyClassRefactoring + clone: self class + as: #'Kernel.SourceFiles' + superclass: Object) + existingVariable: 'Kernel.SourceFiles'! + +testIncompatibleByteSubclassOfFixed + self shouldFail: (CopyClassRefactoring + clone: ByteArray + as: #Foo + superclass: Association) + withMessage: ClassBuilder.ErrorByteSubclassOfFixed! + +testIncompatibleByteSubclassOfVariable + | details | + details := ClassDetails + className: #Foo + superclass: Core.Array + categories: #(). + details isBytes: true. + self shouldFail: (AddClassRefactoring details: details subclasses: #()) + withMessage: ClassBuilder.ErrorByteSubclassOfVariable! + +testIncompatibleFixedPointerSubclassOfBytes + self shouldFail: (CopyClassRefactoring + clone: Association + as: #Foo + superclass: ByteArray) + withMessage: ClassBuilder.ErrorPointerSubclassOfBytes! + +testIncompatibleFixedSubclassOfVariable + self shouldFail: (CopyClassRefactoring + clone: Association + as: #Foo + superclass: Array) + withMessage: ClassBuilder.ErrorFixedSubclassOfVariable! + +testIncompatibleVariablePointerSubclassOfBytes + self shouldFail: (CopyClassRefactoring + clone: Array + as: #Foo + superclass: ByteArray) + withMessage: ClassBuilder.ErrorPointerSubclassOfBytes! + +testNilSuperclass + | refactoring newClass | + refactoring := CopyClassRefactoring + clone: RefactoryTestDataApp + as: #Foo + superclass: nil. + self executeRefactoring: refactoring. + newClass := refactoring model classNamed: #'Refactory.Browser.TestData.Foo'. + self assert: newClass definition + equals: 'nil + subclass: #''Refactory.Browser.TestData.Foo'' + instanceVariableNames: ''temporaryVariable'' + classVariableNames: <1p> + imports: #(#{OS.CRTConstants}) + classInstanceVariableNames: '''' + classConstants: { ''AppConst1'' -> ''ClassConst1 of RefactoryTestDataApp'' }' + << ($\x20 join: RefactoryTestDataApp classVariableNames asSortedArray). + self verify: newClass isCopyOf: RefactoryTestDataApp! + +testSuperclassIsMetaclass + self shouldFail: (CopyClassRefactoring + clone: self class + as: #Foo + superclass: RefactoringTest class) + withMessage: 'Superclass must not be a metaclass'! + +testUnsubclassable + self shouldFail: (CopyClassRefactoring + clone: self class + as: #Foo + superclass: Character) + withMessage: ClassBuilder.ErrorUnsubclassable << Character! + +verify: newClass isCopyOf: sourceClass + self assertIsNil: newClass comment. + self assert: newClass instanceSpec equals: sourceClass instanceSpec. + self verifySameMethods: newClass as: sourceClass. + self verifySameMethods: newClass metaclass as: sourceClass metaclass! + +verifySameMethods: newClass as: sourceClass + self assert: newClass selectors equals: sourceClass selectors. + newClass methodsDo: + [:each | + self assert: each parseTree equals: (sourceClass compiledMethodAt: each selector) parseTree]! ! +!Refactory.Browser.Tests.CopyClassRefactoringTest categoriesForMethods! +testAlreadyExistingInstanceVar!failure tests!public! ! +testBadName!failure tests!public! ! +testCopyByteClass!public!tests! ! +testCopyClass!public!tests! ! +testCopyIndexedClass!public!tests! ! +testDuplicateClassVarName!public!tests! ! +testExistingClassName!failure tests!public! ! +testExistingVariableName!failure tests!public! ! +testIncompatibleByteSubclassOfFixed!public!tests! ! +testIncompatibleByteSubclassOfVariable!public!tests! ! +testIncompatibleFixedPointerSubclassOfBytes!public!tests! ! +testIncompatibleFixedSubclassOfVariable!public!tests! ! +testIncompatibleVariablePointerSubclassOfBytes!public!tests! ! +testNilSuperclass!public!tests! ! +testSuperclassIsMetaclass!failure tests!public! ! +testUnsubclassable!failure tests!public! ! +verify:isCopyOf:!helpers!private! ! +verifySameMethods:as:!helpers!private! ! +! + diff --git a/Core/Object Arts/Dolphin/IDE/Professional/Tools.RefactoringSmalltalkSystem.cls b/Core/Object Arts/Dolphin/IDE/Professional/Tools.RefactoringSmalltalkSystem.cls index 027dc94957..ebce9d62cf 100644 --- a/Core/Object Arts/Dolphin/IDE/Professional/Tools.RefactoringSmalltalkSystem.cls +++ b/Core/Object Arts/Dolphin/IDE/Professional/Tools.RefactoringSmalltalkSystem.cls @@ -550,16 +550,17 @@ extractToTemporary: anInterval from: aSelector in: aClass in: aClass)! handleRefactoringException: aRefactoringException - | text mb | + | text mb defaultCaption | text := aRefactoringException messageText. mb := MessageBox new text: text; iconStyle: aRefactoringException iconStyle; yourself. + defaultCaption := 'Refactoring Error'. aRefactoringException isResumable ifTrue: [mb - caption: '<1d>…' << aRefactoringException refactoring; + caption: '<1d>…' << (aRefactoringException refactoring ?? defaultCaption); isCancellable. text last == $? ifTrue: [mb customButtons: #(#(#yes '&Yes') #(#no 'Cancel'))] @@ -567,12 +568,12 @@ handleRefactoringException: aRefactoringException mb confirm ifTrue: [aRefactoringException resume]] ifFalse: [mb - caption: 'Refactoring Error'; - headline: 'Unable to <1d>' << aRefactoringException refactoring. + caption: defaultCaption; + headline: 'Unable to <1d>' << (aRefactoringException refactoring ?? 'perform refactoring'). aRefactoringException hasTag ifTrue: [mb confirm ifTrue: [aRefactoringException tag value]] ifFalse: [mb warning]. - self abortSignal signal: '<1d> aborted' << aRefactoringException refactoring]. + self abortSignal signal: '<1d> aborted' << (aRefactoringException refactoring ?? 'Refactoring')]. ^aRefactoringException return! inlineAllSelfSendsOf: aCollectionOfMethods within: aBrowserEnvironment @@ -1460,6 +1461,9 @@ selectTargetVariableOf: aClass parseTree: aStMethodNode showChangesText ^'Show proposed changes?'! +validateCreateSubclass: aClassDetails + ^(AddClassRefactoring details: aClassDetails subclasses: #()) preconditions validate! + validateNewClassVarName: aString for: aClass ^(AddClassVariableRefactoring variable: aString class: aClass) preconditions validate caption: 'Invalid new class variable name <1p>' << aString; @@ -1608,6 +1612,7 @@ renameTemporary:to:in:selector:!public!refactoring! ! renameVariable:to:isClassVariable:of:within:!private!refactoring! ! selectTargetVariableOf:parseTree:!helpers!private!refactoring! ! showChangesText!constants!private! ! +validateCreateSubclass:!helpers!private!refactoring! ! validateNewClassVarName:for:!helpers!private!refactoring! ! validateNewInstanceVariableName:for:!enquiries!helpers!private!refactoring! ! validateRenameClass:to:!helpers!private! !