SystemOrganization addCategory: #'Refactoring-Critics'! SystemOrganization addCategory: #'Refactoring-Critics-BlockRules'! SystemOrganization addCategory: #'Refactoring-Critics-ParseTreeRules'! SystemOrganization addCategory: #'Refactoring-Critics-TransformationRules'! RBSelectorEnvironment subclass: #RBParseTreeEnvironment instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBParseTreeEnvironment methodsFor: 'initialize-release' stamp: ''! matcher: aParseTreeSearcher matcher := aParseTreeSearcher! ! !RBParseTreeEnvironment methodsFor: 'accessing' stamp: 'lr 5/14/2010 13:42'! selectionIntervalFor: aString | parseTree node | matcher isNil ifTrue: [ ^ super selectionIntervalFor: aString ]. parseTree := RBParser parseMethod: aString onError: [ :error :position | ^ super selectionIntervalFor: aString ]. node := matcher executeTree: parseTree initialAnswer: nil. ^ (node isKindOf: RBProgramNode) ifTrue: [ node sourceInterval ] ifFalse: [ super selectionIntervalFor: aString ]! ! RBBrowserEnvironmentWrapper subclass: #RBMultiEnvironment instanceVariableNames: 'environmentDictionaries' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBMultiEnvironment methodsFor: 'adding' stamp: 'lr 9/8/2011 20:32'! addClass: aClass into: aValue (environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) addClass: aClass! ! !RBMultiEnvironment methodsFor: 'adding' stamp: 'lr 9/8/2011 20:32'! addClass: aClass selector: aSymbol into: aValue (environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) addClass: aClass selector: aSymbol! ! !RBMultiEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! asSelectorEnvironment | s | s := RBSelectorEnvironment new. s label: self label. environmentDictionaries do: [:each | | env | env := each asSelectorEnvironment. env classesDo: [:cls | env selectorsForClass: cls do: [:sel | s addClass: cls selector: sel]]]. ^ s ! ! !RBMultiEnvironment methodsFor: 'accessing' stamp: ''! environments ^environmentDictionaries keys! ! !RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:53'! includesCategory: aCategory ^ (super includesCategory: aCategory) and: [ environmentDictionaries anySatisfy: [ :env | env includesCategory: aCategory ] ]! ! !RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:52'! includesClass: aClass ^ (super includesClass: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesClass: aClass ] ]! ! !RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:54'! includesProtocol: aProtocol in: aClass ^ (super includesProtocol: aProtocol in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesProtocol: aProtocol in: aClass ] ]! ! !RBMultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:53'! includesSelector: aSelector in: aClass ^ (super includesSelector: aSelector in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesSelector: aSelector in: aClass ] ]! ! !RBMultiEnvironment methodsFor: 'initialize-release' stamp: 'lr 9/8/2011 20:32'! initialize super initialize. environmentDictionaries := Dictionary new. environment := RBSelectorEnvironment new! ! !RBMultiEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^environmentDictionaries isEmpty! ! !RBMultiEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^environmentDictionaries size! ! !RBMultiEnvironment methodsFor: 'removing' stamp: 'lr 9/8/2011 20:32'! removeClass: aClass into: aValue (environmentDictionaries at: aValue ifAbsent: [RBSelectorEnvironment new]) removeClass: aClass! ! !RBMultiEnvironment methodsFor: 'removing' stamp: 'lr 9/8/2011 20:32'! removeClass: aClass selector: aSelector into: aValue (environmentDictionaries at: aValue ifAbsentPut: [RBSelectorEnvironment new]) removeClass: aClass selector: aSelector! ! !RBMultiEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! selectEnvironment: aValue environment := environmentDictionaries at: aValue ifAbsent: [RBSelectorEnvironment new]! ! Object subclass: #RBLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! RBLintRule subclass: #RBBasicLintRule instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! filteredResult "Be very careful when filtering results not to introduce new items and not to lose the dedicated browser environments. Try the following steps in order: - If this is a selector environment use the set-operations of the refactoring browser. - If this is a class environment, remove the classes that have a filter annotation in any of its methods. - If this is a variable environment, remove the classes and all its variables that have a filter annotation in any of its methods. - Otherwise return the unfiltered environment." | filter | result isEmpty ifTrue: [ ^ result ]. filter := RBPragmaEnvironment onEnvironment: RBBrowserEnvironment new keywords: #( lint: lint:rationale: lint:rationale:author: lint:author: ignoreLintRule: ignoreLintRule:rationale: ignoreLintRule:rationale:author: ignoreLintRule:author: ). filter condition: [ :pragma | pragma arguments first = self name or: [ pragma arguments first = self group or: [ pragma arguments first = self class name ] ] ]. result isSelectorEnvironment ifTrue: [ ^ (result & filter not) label: result label ]. result isClassEnvironment ifTrue: [ filter classesDo: [ :class | result removeClass: class theMetaClass; removeClass: class theNonMetaClass ] ] ifFalse: [ result isVariableEnvironment ifTrue: [ filter classesDo: [ :class | class classVarNames do: [ :var | result removeClass: class classVariable: var ]. class instVarNames do: [ :var | result removeClass: class instanceVariable: var ] ] ] ]. ^ result! ! !RBBasicLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:39'! initialize super initialize. self resetResult ! ! !RBBasicLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:37'! isEmpty ^ self result isEmpty! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'! problemCount ^ self result problemCount! ! !RBBasicLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:39'! resetResult result := self resultClass new. result label: self name! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'! result ^ result! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:28'! resultClass self subclassResponsibility! ! RBBasicLintRule subclass: #RBBlockLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! RBBlockLintRule subclass: #RBAbstractClassRule instanceVariableNames: 'subclassResponsibilitySymbol' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBAbstractClassRule methodsFor: 'running' stamp: 'lr 7/23/2010 08:03'! checkClass: aContext (aContext selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol) isEmpty ifFalse: [ (aContext uses: (Smalltalk globals associationAt: aContext selectedClass name ifAbsent: [ nil ])) ifTrue: [ result addClass: aContext selectedClass ] ]! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBAbstractClassRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 00:34'! initialize super initialize. subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'References an abstract class'! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for references to classes that have subclassResponsibility methods. Such references might be creating instances of the abstract class or more commonly being used as the argument to an isKindOf: message which is considered bad style.'! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBAddRemoveDependentsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBAddRemoveDependentsRule methodsFor: 'running' stamp: 'lr 11/2/2009 23:38'! checkClass: aContext | count | count := 0. ((Set withAll: (aContext selectedClass whichSelectorsReferTo: #addDependent:)) addAll: (aContext selectedClass whichSelectorsReferTo: #removeDependent:); yourself) do: [ :sel | (aContext selectedClass compiledMethodAt: sel) messagesDo: [ :each | each = #addDependent: ifTrue: [ count := count + 1 ]. each = #removeDependent: ifTrue: [ count := count - 1 ] ] ]. count > 0 ifTrue: [ result addClass: aContext selectedClass ]! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Number of addDependent: messages > removeDependent:'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check that the number of addDependent: message sends in a class is less than or equal to the number of removeDependent: messages. If there are more addDependent: messages that may signify that some dependents are not being released, which may lead to memory leaks.'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBBadMessageRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBBadMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:09'! badSelectors ^ #( #become: #isKindOf: #changeClassToThatOf: #respondsTo: #isMemberOf: #performMethod: #performMethod:arguments: #performMethod:with: #performMethod:with:with: #performMethod:with:with:with: #allOwners #allOwnersWeakly: #firstOwner #instVarAt: #instVarAt:put: #nextInstance #nextObject #ownerAfter: #primBecome: #halt )! ! !RBBadMessageRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:10'! checkClass: aContext | selectors | selectors := self badSelectors inject: Set new into: [ :set :each | set addAll: (aContext selectedClass whichSelectorsReferTo: each); yourself ]. selectors do: [ :each | result addClass: aContext selectedClass selector: each ]. selectors isEmpty ifFalse: [ result searchStrings: self badSelectors ]! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends "questionable" message'! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check methods that send messages that perform low level things. You might want to limit the number of such messages in your application. For example, using become: throughout your application might not be the best thing. Also, messages such as isKindOf: can signify a lack of polymorphism. You can change which methods are "questionable" by editing the BasicLintRule>>badSelectors method.'! ! !RBBlockLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBBlockLintRule! ! !RBBlockLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBSelectorEnvironment! ! RBBlockLintRule subclass: #RBClassInstVarNotInitializedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBClassInstVarNotInitializedRule methodsFor: 'running' stamp: 'pmm 6/26/2011 13:16'! checkClass: aContext | definesVar class | aContext selectedClass isMeta ifTrue: [ class := aContext selectedClass. definesVar := false. [ definesVar or: [ class isNil or: [ class isMeta not ] ] ] whileFalse: [ definesVar := class instVarNames isEmpty not "TestCase defines Announcers but does not initialize it -> all tests are reported so we exclude it here" and: [ class ~= TestCase class and: [ aContext selectedClass ~= TestCase ] ]. class := class superclass ]. (definesVar and: [ (aContext selectedClass includesSelector: #initialize) not ]) ifTrue: [ result addClass: aContext selectedClass ] ]! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Has class instance variables but no initialize method'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all classes that have class instance variables also have an initialize method. This makes sure that all class instance variables are initialized properly when the class is filed-into a new image.'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBClassNameInSelectorRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBClassNameInSelectorRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass isMeta and: [ (aContext selector indexOfSubCollection: aContext selectedClass soleInstance name startingAt: 1) > 0 ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Redundant class name in selector'! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for the class name in a selector. This is redundant since to call the you must already refer to the class name. For example, openHierarchyBrowserFrom: is a redundant name for HierarchyBrowser.'! ! RBBlockLintRule subclass: #RBClassNotReferencedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBClassNotReferencedRule methodsFor: 'running' stamp: 'lr 3/7/2011 21:46'! checkClass: aContext | assoc | (aContext selectedClass isMeta or: [ aContext selectedClass subclasses notEmpty or: [ aContext includesBehaviorNamed: #TestCase ] ]) ifTrue: [ ^ self ]. assoc := Smalltalk globals associationAt: aContext selectedClass name. ((aContext uses: assoc) or: [ aContext uses: aContext selectedClass name ]) ifFalse: [ result addClass: aContext selectedClass; addClass: aContext selectedClass class ]! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Class not referenced'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check if a class is referenced either directly or indirectly by a symbol. If a class is not referenced, it can be removed.'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBBlockLintRule subclass: #RBClassVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBClassVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 1/21/2010 23:42'! checkClass: aContext aContext selectedClass isMeta ifTrue: [ ^ self ]. aContext selectedClass classVarNames do: [ :each | each first isUppercase ifFalse: [ result addClass: aContext selectedClass classVariable: each ] ]. aContext selectedClass poolDictionaryNames do: [ :each | each first isUppercase ifFalse: [ result addClass: aContext selectedClass classVariable: each ] ]! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Class variable capitalization'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 20:34'! rationale ^ 'Class and pool variable names should start with an uppercase letter.'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! RBBlockLintRule subclass: #RBCollectionCopyEmptyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBCollectionCopyEmptyRule methodsFor: 'running' stamp: 'lr 10/11/2009 11:30'! checkClass: aContext (aContext selectedClass isVariable and: [ (aContext selectedClass includesSelector: #copyEmpty) not and: [ aContext selectedClass instVarNames isEmpty not and: [ aContext selectedClass inheritsFrom: Collection ] ] ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Subclass of collection that has instance variable but doesn''t define copyEmpty'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all subclasses of the Collection classes that add an instance variable also redefine the copyEmpty method. This method is used when the collection grows. It copies over the necessary instance variables to the new larger collection.'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBDefinesEqualNotHashRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBDefinesEqualNotHashRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext ((aContext selectedClass includesSelector: #=) and: [ (aContext selectedClass includesSelector: #hash) not ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Defines = but not hash'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all classes that define = also define hash. If hash is not defined then the instances of the class might not be able to be used in sets since equal element must have the same hash.'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBEquivalentSuperclassMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBEquivalentSuperclassMethodsRule methodsFor: 'running' stamp: 'lr 4/30/2010 12:07'! checkMethod: aContext | superclass supertree | (self ignoredSelectors includes: aContext selector) ifTrue: [ ^ self ]. aContext selectedClass superclass notNil ifTrue: [ superclass := aContext selectedClass superclass whichClassIncludesSelector: aContext selector. superclass notNil ifTrue: [ supertree := superclass parseTreeFor: aContext selector. (supertree notNil and: [ supertree equalTo: aContext parseTree exceptForVariables: supertree allDefinedVariables ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ] ]! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 4/30/2010 12:08'! ignoredSelectors "These methods are often overridden for compatilbity with other platforms." ^ #( new initialize )! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Methods equivalently defined in superclass'! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that are equivalent to their superclass methods. Such methods don''t add anything to the computation and can be removed since the superclass''s method will work just fine.'! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBBlockLintRule subclass: #RBExcessiveArgumentsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBExcessiveArgumentsRule methodsFor: 'private' stamp: 'lr 6/15/2009 15:59'! argumentsCount ^ 5! ! !RBExcessiveArgumentsRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:00'! checkMethod: aContext aContext selector numArgs >= self argumentsCount ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:52'! group ^ 'Miscellaneous'! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:00'! name ^ 'Excessive number of arguments'! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:55'! rationale ^ 'Long argument lists can indicate that a new object should be created to wrap the numerous parameters.'! ! RBBlockLintRule subclass: #RBExcessiveInheritanceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBExcessiveInheritanceRule methodsFor: 'running' stamp: 'lr 8/11/2010 18:49'! checkClass: aContext | count current | aContext selectedClass isMeta ifTrue: [ ^ self ]. count := 1. current := aContext selectedClass. [ current isNil ] whileFalse: [ self inheritanceDepth < count ifTrue: [ ^ result addClass: aContext selectedClass; addClass: aContext selectedClass class ]. current := current superclass. count := count + 1 ]! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! group ^ 'Miscellaneous'! ! !RBExcessiveInheritanceRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:22'! inheritanceDepth ^ 10! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! name ^ 'Excessive inheritance depth'! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! rationale ^ 'Deep inheritance is usually a sign of a design flaw. Try to break it down, and reduce the inheritance to something manageable.'! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBExcessiveMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBExcessiveMethodsRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:14'! checkClass: aContext aContext selectedClass selectors size >= self methodsCount ifTrue: [ result addClass: aContext selectedClass ]! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:57'! group ^ 'Miscellaneous'! ! !RBExcessiveMethodsRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:23'! methodsCount ^ 40! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:58'! name ^ 'Excessive number of methods'! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:58'! rationale ^ 'Large classes are indications that the class may be trying to do too much. Try to break it down, and reduce the size to something manageable.'! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBExcessiveVariablesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBExcessiveVariablesRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:16'! checkClass: aContext (aContext selectedClass instVarNames size >= self variablesCount or: [ aContext selectedClass classVarNames size >= self variablesCount ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! group ^ 'Miscellaneous'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! name ^ 'Excessive number of variables'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! rationale ^ 'Classes that have too many instance variables could be redesigned to have fewer fields, possibly through some nested object grouping.'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! !RBExcessiveVariablesRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:23'! variablesCount ^ 10! ! RBBlockLintRule subclass: #RBImplementedNotSentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBImplementedNotSentRule methodsFor: 'running' stamp: 'lr 3/7/2011 21:52'! checkMethod: aContext "Check if there are any senders. Furthermore methods with pragmas are likely to be sent through reflection, thus do not report those. Also test methods are sent through reflection, so ignore those as well." (aContext uses: aContext selector) ifTrue: [ ^ self ]. (aContext compiledMethod pragmas isEmpty) ifFalse: [ ^ self ]. (aContext selectedClass isMeta not and: [ aContext includesBehaviorNamed: #TestCase ]) ifTrue: [ ^ self ]. result addClass: aContext selectedClass selector: aContext selector! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Methods implemented but not sent'! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that are never sent. If a method is not sent, it can be removed.'! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:02'! severity ^ #information! ! RBBlockLintRule subclass: #RBInconsistentMethodClassificationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBInconsistentMethodClassificationRule methodsFor: 'running' stamp: 'lr 3/13/2009 11:41'! checkMethod: aContext | superClass superProtocol ownerProtocol | aContext selectedClass superclass isNil ifFalse: [ superClass := aContext selectedClass superclass whichClassIncludesSelector: aContext selector. superClass isNil ifFalse: [ superProtocol := superClass whichCategoryIncludesSelector: aContext selector. ownerProtocol := aContext selectedClass whichCategoryIncludesSelector: aContext selector. (superProtocol isNil or: [ superProtocol isEmpty or: [ superProtocol first = $* or: [ ownerProtocol isNil or: [ ownerProtocol isEmpty or: [ ownerProtocol first = $* ] ] ] ] ]) ifFalse: [ superProtocol = ownerProtocol ifFalse: [ result addClass: superClass selector: aContext selector into: superProtocol; addClass: aContext selectedClass selector: aContext selector into: superProtocol ] ] ] ]! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Inconsistent method classification'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'All methods should be put into a protocol (method category) that is equivalent to the one of the superclass.'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! resultClass ^ RBMultiEnvironment! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:02'! severity ^ #information! ! RBBlockLintRule subclass: #RBInstVarInSubclassesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBInstVarInSubclassesRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | subs | subs := aContext selectedClass subclasses. subs size > 1 ifTrue: [ | sels | sels := Bag new. subs do: [ :each | sels addAll: each instVarNames ]. sels asSet do: [ :val | | count | count := sels occurrencesOf: val. count == subs size ifTrue: [ result addClass: aContext selectedClass instanceVariable: val ] ] ]! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variables defined in all subclasses'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks classes for instance variables that are defined in all subclasses. Many times you might want to pull the instance variable up into the class so that all the subclasses do not have to define it.'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:03'! severity ^ #information! ! RBBlockLintRule subclass: #RBInstanceVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBInstanceVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 7/3/2009 20:34'! checkClass: aContext aContext selectedClass instVarNames do: [ :each | each first isLowercase ifFalse: [ result addClass: aContext selectedClass instanceVariable: each ] ]! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variable capitalization'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Instance variable names on the instance- and class-side should start with a lowercase letter.'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! RBBlockLintRule subclass: #RBJustSendsSuperRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBJustSendsSuperRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:11'! checkMethod: aContext (aContext parseTree isPrimitive not and: [ matcher executeMethod: aContext parseTree initialAnswer: false ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBJustSendsSuperRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher justSendsSuper! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method just sends super message'! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that just forward the message to its superclass. These methods can be removed.'! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'! severity ^ #information! ! RBBlockLintRule subclass: #RBLiteralArrayContainsCommaRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBLiteralArrayContainsCommaRule methodsFor: 'running' stamp: 'lr 2/6/2010 13:32'! checkMethod: aContext (aContext compiledMethod allLiterals anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBLiteralArrayContainsCommaRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:32'! doesLiteralArrayContainComma: aLiteral aLiteral class = Array ifFalse: [ ^ false ]. (aLiteral includes: #,) ifTrue: [ ^ true ]. ^ aLiteral anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]! ! !RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains a #,'! ! !RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:54'! rationale ^ 'Checks for literal arrays that contain the #, symbol.'! ! RBBlockLintRule subclass: #RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'running' stamp: 'lr 9/7/2010 21:59'! checkMethod: aContext | compiledLits parsedLits | compiledLits := aContext compiledMethod allLiterals inject: OrderedCollection new into: [ :collection :literal | collection addAll: (self literalTrueFalseOrNilSymbolsIn: literal); yourself ]. compiledLits size > 0 ifTrue: [ parsedLits := OrderedCollection new. matcher executeTree: aContext parseTree initialAnswer: parsedLits. compiledLits size ~= parsedLits size ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ]! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'initialization' stamp: 'lr 2/6/2010 13:50'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '`#array `{ :node | node isLiteralArray and: [ node isForByteArray not ] }' do: [ :node :answer | answer addAll: (self literalTrueFalseOrNilSymbolsIn: node value); yourself ]! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:21'! literalTrueFalseOrNilSymbolsIn: aLiteral | retval | aLiteral class == Array ifFalse: [ ^ #() ]. retval := OrderedCollection withAll: (aLiteral select: [ :each | each isSymbol and: [ #(#true #false #nil ) includes: each ] ]). aLiteral do: [ :each | retval addAll: (self literalTrueFalseOrNilSymbolsIn: each) ]. ^ retval! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains a #true, #false, or #nil but the source doesn''t.'! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'With ANSI changes, #(true false nil) now is equal to {true. false. nil} not {#true. #false. #nil} as it used to be. This may be a bug.'! ! RBBlockLintRule subclass: #RBLongMethodsRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBLongMethodsRule methodsFor: 'running' stamp: 'lr 6/15/2009 15:56'! checkMethod: aContext (matcher executeTree: aContext parseTree initialAnswer: 0) >= self longMethodSize ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBLongMethodsRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '`.Stmt' do: [:aNode :answer | (aNode children inject: answer into: [:sum :each | matcher executeTree: each initialAnswer: sum]) + 1].! ! !RBLongMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:12'! longMethodSize ^ 10! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Long methods'! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Returns all methods that have BasicLintRule class>>longMethodSize number of statements. This check counts statements, not lines.'! ! RBBlockLintRule subclass: #RBMethodHasNoTimeStampRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMethodHasNoTimeStampRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext aContext compiledMethod timeStamp isEmpty ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method has no timeStamp'! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'For proper versioning, every method should have a timestamp.'! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'! severity ^ #error! ! RBBlockLintRule subclass: #RBMethodModifierFinalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMethodModifierFinalRule methodsFor: 'running' stamp: 'lr 11/4/2010 12:43'! checkMethod: aContext | current | current := aContext selectedClass superclass. [ current notNil ] whileTrue: [ current methodDictionary at: aContext selector ifPresent: [ :method | (method pragmas anySatisfy: [ :each | each keyword = #modifier: and: [ each arguments first = #final ] ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ]. current := current superclass ]! ! !RBMethodModifierFinalRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:40'! group ^ 'Bugs'! ! !RBMethodModifierFinalRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:40'! name ^ 'Overrides a final method'! ! !RBMethodModifierFinalRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:57'! rationale ^ 'Checks that a methods marked with is never overridden.'! ! !RBMethodModifierFinalRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:40'! severity ^ #error! ! RBBlockLintRule subclass: #RBMethodModifierOverrideRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMethodModifierOverrideRule methodsFor: 'running' stamp: 'lr 11/4/2010 13:06'! checkMethod: aContext (aContext compiledMethod pragmas anySatisfy: [ :each | each keyword = #modifier: and: [ each arguments first = #override ] ]) ifFalse: [ ^ self ]. (aContext selectedClass superclass isNil) ifTrue: [ ^ self ]. (aContext selectedClass superclass whichClassIncludesSelector: aContext selector) isNil ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBMethodModifierOverrideRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:53'! group ^ 'Bugs'! ! !RBMethodModifierOverrideRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:56'! name ^ 'Missing super implementation'! ! !RBMethodModifierOverrideRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:57'! rationale ^ 'Checks that a methods marked with overrides an actual superclass method.'! ! !RBMethodModifierOverrideRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:53'! severity ^ #error! ! RBBlockLintRule subclass: #RBMethodModifierSuperRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMethodModifierSuperRule methodsFor: 'running' stamp: 'lr 11/4/2010 12:46'! checkMethod: aContext | current | (aContext superMessages includes: aContext selector) ifTrue: [ ^ self ]. current := aContext selectedClass superclass. [ current notNil ] whileTrue: [ current methodDictionary at: aContext selector ifPresent: [ :method | (method pragmas anySatisfy: [ :each | each keyword = #modifier: and: [ each arguments first = #super ] ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ]. current := current superclass ]! ! !RBMethodModifierSuperRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:44'! group ^ 'Bugs'! ! !RBMethodModifierSuperRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:45'! name ^ 'Super call required'! ! !RBMethodModifierSuperRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 13:07'! rationale ^ 'Checks that a methods marked with are always called when overridden.'! ! !RBMethodModifierSuperRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:44'! severity ^ #error! ! RBBlockLintRule subclass: #RBMethodSourceContainsLinefeedsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMethodSourceContainsLinefeedsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext sourceCode includes: Character lf) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method source contains linefeeds'! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 5/12/2010 23:38'! rationale ^ 'Pharo code should not contain linefeed characters.'! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'! severity ^ #error! ! RBBlockLintRule subclass: #RBMissingSubclassResponsibilityRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMissingSubclassResponsibilityRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | subs | subs := aContext selectedClass subclasses. (subs size > 1 and: [ aContext selectedClass isMeta not ]) ifTrue: [ | sels | sels := Bag new. subs do: [ :each | sels addAll: each selectors ]. sels asSet do: [ :each | ((sels occurrencesOf: each) == subs size and: [ (aContext selectedClass canUnderstand: each) not ]) ifTrue: [ | envName | envName := aContext selectedClass name , '>>' , each. subs do: [ :subClass | result addClass: subClass selector: each into: envName ] ] ] ]! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method defined in all subclasses, but not in superclass'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks classes for methods that are defined in all subclasses, but not defined in self. Such methods should most likely be defined as subclassResponsibility methods to help document the class. Furthermore, this check helps to find similar code that might be occurring in all the subclasses that should be pulled up into the superclass.'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! resultClass ^ RBMultiEnvironment! ! RBBlockLintRule subclass: #RBMissingSuperSendsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBMissingSuperSendsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:52'! checkMethod: aContext | definer superMethod | (aContext selectedClass isMeta not and: [ self superMessages includes: aContext selector ]) ifTrue: [ definer := aContext selectedClass superclass ifNotNilDo: [ :sc | sc whichClassIncludesSelector: aContext selector ]. definer ifNotNil: [ "super defines same method" (aContext superMessages includes: aContext selector) ifFalse: [ "but I don't call it" superMethod := definer compiledMethodAt: aContext selector ifAbsent: [ ]. (superMethod isReturnSelf or: [ superMethod sendsSelector: #subclassResponsibility ]) ifFalse: [ result addClass: aContext selectedClass selector: aContext selector ] ] ] ]! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! group ^ 'Possible bugs'! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! name ^ 'Missing super sends in selected methods.'! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! rationale ^ 'Checks that some methods contain a super message send. Some methods should always contain a super message send. For example, the postCopy method should always contain a "super postCopy". The list of methods that should contain super message sends is in BasicLintRule>>superMessages.'! ! !RBMissingSuperSendsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:17'! superMessages ^#(#release #postCopy #postBuildWith: #preBuildWith: #postOpenWith: #noticeOfWindowClose: #initialize)! ! RBBlockLintRule subclass: #RBNoClassCommentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBNoClassCommentRule methodsFor: 'running' stamp: 'lr 3/7/2011 21:40'! checkClass: aContext (aContext selectedClass isMeta or: [ aContext includesBehaviorNamed: #TestCase ]) ifTrue: [ ^ self ]. aContext selectedClass organization classComment isEmpty ifTrue: [ result addClass: aContext selectedClass; addClass: aContext selectedClass class ]! ! !RBNoClassCommentRule methodsFor: 'accessing' stamp: 'cyrille.delaunay 8/11/2010 16:50'! group ^ 'Miscellaneous'! ! !RBNoClassCommentRule methodsFor: 'accessing' stamp: 'cyrille.delaunay 8/11/2010 16:51'! name ^ 'No class comment'! ! !RBNoClassCommentRule methodsFor: 'accessing' stamp: 'lr 8/11/2010 18:40'! rationale ^ 'Classes should have comments to explain their purpose, collaborations with other classes, and optionally provide examples of use.'! ! !RBNoClassCommentRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBClassEnvironment! ! RBBlockLintRule subclass: #RBOnlyReadOrWrittenVariableRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBOnlyReadOrWrittenVariableRule methodsFor: 'running' stamp: 'lr 4/29/2010 19:35'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext selectedClass instVarNames do: [ :each | | isRead isWritten | isRead := false. isWritten := false. allSubclasses detect: [ :class | isRead ifFalse: [ isRead := (class whichSelectorsReallyRead: each) isEmpty not ]. isWritten ifFalse: [ isWritten := (class whichSelectorsAssign: each) isEmpty not ]. isRead and: [ isWritten ] ] ifNone: [ result addClass: aContext selectedClass instanceVariable: each ] ]! ! !RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variables not read AND written'! ! !RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all instance variables are both read and written. If an instance variable is only read, you can replace all of the reads with nil, since it couldn''t have been assigned a value. If the variable is only written, then we don''t need to store the result since we never use it. This check does not work for the data model classes since they use the instVarAt:put: messages to set instance variables.'! ! !RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! !RBOnlyReadOrWrittenVariableRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'! severity ^ #information! ! RBBlockLintRule subclass: #RBOverridesSpecialMessageRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBOverridesSpecialMessageRule methodsFor: 'running' stamp: 'lr 1/21/2010 23:42'! checkClass: aContext | selectors | selectors := aContext selectedClass isMeta ifTrue: [ self metaclassShouldNotOverride ] ifFalse: [ self classShouldNotOverride ]. selectors do: [ :each | (aContext selectedClass superclass notNil and: [ (aContext selectedClass superclass canUnderstand: each) and: [ (aContext selectedClass includesSelector: each) ] ]) ifTrue: [ result addClass: aContext selectedClass selector: each ] ]! ! !RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:12'! classShouldNotOverride ^ #( #== #~~ #class #basicAt: #basicAt:put: #basicSize #identityHash )! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:13'! metaclassShouldNotOverride ^ #( #basicNew #basicNew #class #comment #name )! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Overrides a "special" message'! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 20:07'! rationale ^ 'Checks that a class does not override a message that is essential to the base system. For example, if you override the #class method from object, you are likely to crash your image.'! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBRefersToClassRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBRefersToClassRule methodsFor: 'running' stamp: 'lr 7/23/2010 08:03'! checkClass: aContext | sels className | className := aContext selectedClass theNonMetaClass name. sels := aContext selectedClass whichSelectorsReferTo: (Smalltalk globals associationAt: className). sels do: [ :each | result addClass: aContext selectedClass selector: each ]. sels isEmpty ifFalse: [ result addSearchString: className ]! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Refers to class name instead of "self class"'! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for classes that have their class name directly in the source instead of "self class". The self class variant allows you to create subclasses without needing to redefine that method.'! ! RBBlockLintRule subclass: #RBReturnsBooleanAndOtherRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBReturnsBooleanAndOtherRule methodsFor: 'running' stamp: 'lr 8/19/2009 20:54'! checkMethod: aContext | hasBool hasSelf | hasBool := false. hasSelf := aContext parseTree lastIsReturn not. (matcher executeTree: aContext parseTree initialAnswer: Set new) do: [ :each | hasBool := hasBool or: [ (each isLiteral and: [ #(true false) includes: each value ]) or: [ (each isMessage and: [ #(and: or:) includes: each selector ]) ] ]. hasSelf := hasSelf or: [ (each isVariable and: [ each name = 'self' ]) or: [ (each isLiteral and: [ (#(true false) includes: each value) not ]) ] ] ]. (hasSelf and: [ hasBool ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnsBooleanAndOtherRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '^ ``@object' do: [ :node :answer | answer add: node value; yourself ]! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Returns a boolean and non boolean'! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that return a boolean value (true or false) and return some other value such as (nil or self). If the method is suppose to return a boolean, then this signifies that there is one path through the method that might return a non-boolean. If the method doesn''t need to return a boolean, you should probably rewrite it to return some non-boolean value since other programmers reading your method might assume that it returns a boolean.'! ! RBBlockLintRule subclass: #RBSendsDifferentSuperRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBSendsDifferentSuperRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | message | (message := aContext superMessages detect: [ :each | each ~= aContext selector ] ifNone: [ nil ]) notNil ifTrue: [ result addSearchString: message. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends different super message'! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods whose source sends a different super message.'! ! RBBlockLintRule subclass: #RBSentNotImplementedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBSentNotImplementedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | message | message := aContext messages detect: [ :each | (aContext implements: each) not ] ifNone: [ aContext superMessages detect: [ :each | aContext selectedClass superclass isNil or: [ (aContext selectedClass superclass canUnderstand: each) not ] ] ifNone: [ aContext selfMessages detect: [ :each | (aContext selectedClass canUnderstand: each) not ] ifNone: [ nil ] ] ]. message notNil ifTrue: [ result addSearchString: message. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Messages sent but not implemented'! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for messages that are sent by a method, but no class in the system implements such a message. Further checks if messages sent to self or super exist in the hierarchy, since these can be statically typed. Reported methods will certainly cause a doesNotUnderstand: message when they are executed.'! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBSubclassResponsibilityNotDefinedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext (aContext selectedClass whichSelectorsReferTo: #subclassResponsibility) do: [ :each | (aContext selectedClass withAllSubclasses detect: [ :class | class subclasses isEmpty and: [ (class whichClassIncludesSelector: each) == aContext selectedClass ] ] ifNone: [ nil ]) notNil ifTrue: [ result addClass: aContext selectedClass selector: each ] ]! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Subclass responsibility not defined'! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all subclassResponsibility methods are defined in all leaf classes.'! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBSuperSendsNewRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBSuperSendsNewRule methodsFor: 'running' stamp: 'lr 2/26/2009 16:32'! checkMethod: aContext aContext selectedClass isMeta ifTrue: [ ^ self ]. (matcher executeTree: aContext parseTree initialAnswer: false) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBSuperSendsNewRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matchesAnyOf: #( 'super new initialize' '(super new: `@expr) initialize' 'self new initialize' '(self new: `@expr) initialize' ) do: [ :answer :node | true ].! ! !RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends super new initialize'! ! !RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:50'! rationale ^ 'Checks for method that wrongly initialize an object twice. Contrary to other Smalltalk implementations Pharo automatically calls #initiailize on object creation.'! ! RBBlockLintRule subclass: #RBTempVarOverridesInstVarRule instanceVariableNames: 'matcher varName vars' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBTempVarOverridesInstVarRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:14'! checkMethod: aContext vars := aContext instVarNames. (matcher executeTree: aContext parseTree initialAnswer: false) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: varName ]! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBTempVarOverridesInstVarRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matchesArgument: '`var' do: [:aNode :answer | answer or: [varName := aNode name. vars includes: varName]]! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variable overridden by temporary variable'! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Finds methods that have block are temporary variables that override an instance variable. This causes problems if you want to use the instance variable inside the method.'! ! RBBlockLintRule subclass: #RBTemporaryVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBTemporaryVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext aContext parseTree allDefinedVariables do: [ :each | each first isLowercase ifFalse: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ] ]! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Temporary variable capitalization'! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Temporary and argument variable names should start with a lowercase letter.'! ! RBBlockLintRule subclass: #RBTempsReadBeforeWrittenRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBTempsReadBeforeWrittenRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: aContext parseTree) do: [ :each | result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ]! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Temporaries read before written'! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all temporaries are assigned before they are used. This can help find possible paths through the code where a variable might be unassigned when it is used.'! ! RBBlockLintRule subclass: #RBUnclassifiedMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUnclassifiedMethodsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass organization categoryOfElement: aContext selector) = Categorizer default ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unclassified methods'! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'All methods should be put into a protocol (method category) for better readability.'! ! RBBlockLintRule subclass: #RBUncommonMessageSendRule instanceVariableNames: 'literalNames' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUncommonMessageSendRule methodsFor: 'running' stamp: 'lr 3/28/2009 14:26'! checkMethod: aContext aContext messages do: [ :each | (each isEmpty or: [ each first isUppercase or: [ literalNames includes: each ] ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ] ]! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:21'! group ^ 'Possible bugs'! ! !RBUncommonMessageSendRule methodsFor: 'initialization' stamp: 'lr 9/7/2010 20:51'! initialize super initialize. literalNames := #(#self #super #thisContext #true #false #nil) asIdentitySet! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:22'! name ^ 'Uncommon message send'! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:34'! rationale ^ 'Sending messages with a common literal with an uppercase selector name are usually bugs, introduced through missing statement separators.'! ! RBBlockLintRule subclass: #RBUndeclaredReferenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUndeclaredReferenceRule methodsFor: 'running' stamp: 'lr 6/4/2010 12:05'! checkMethod: aContext | undeclared | undeclared := Undeclared associations detect: [ :each | (aContext uses: each) and: [ aContext compiledMethod refersToLiteral: each ] ] ifNone: [ nil ]. undeclared notNil ifTrue: [ result addSearchString: undeclared key. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'References an undeclared variable'! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for references to a variable in the Undeclared dictionary. If you remove a variable from a class that is accessed by a method, you will create an undeclared variable reference for those methods that accessed the variable.'! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBUnpackagedCodeRule instanceVariableNames: 'packages package' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUnpackagedCodeRule methodsFor: 'running' stamp: 'lr 3/20/2009 09:14'! checkClass: aContext (aContext selectedClass isMeta not and: [ (self packageSatisfying: [ :info | info includesSystemCategory: aContext selectedClass category ]) isNil ]) ifTrue: [ self result addClass: aContext selectedClass ]! ! !RBUnpackagedCodeRule methodsFor: 'running' stamp: 'lr 3/20/2009 09:14'! checkMethod: aContext (self packageSatisfying: [ :info | info includesMethod: aContext selector ofClass: aContext selectedClass ]) isNil ifTrue: [ self result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 17:21'! group ^ 'Possible bugs'! ! !RBUnpackagedCodeRule methodsFor: 'initialization' stamp: 'lr 3/20/2009 08:21'! initialize super initialize. packages := MCWorkingCopy allManagers collect: [ :each | each packageInfo ]! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 08:20'! name ^ 'Unpackaged code'! ! !RBUnpackagedCodeRule methodsFor: 'private' stamp: 'lr 3/20/2009 09:17'! packageSatisfying: aBlock "Answer the first package satisfying aBlock or nil. This method assumes that it is likely that the last matching package matches the given condition again and thus it tries that one first." (package notNil and: [ aBlock value: package ]) ifTrue: [ ^ package ]. packages do: [ :info | (aBlock value: info) ifTrue: [ ^ package := info ] ]. ^ nil! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/9/2010 16:08'! rationale ^ 'Code that is not contained in a Monticello package is not versioned and cannot be brought into a different image.'! ! RBBlockLintRule subclass: #RBUnreferencedVariablesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUnreferencedVariablesRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext selectedClass instVarNames do: [ :each | allSubclasses detect: [ :class | (class whichSelectorsAccess: each) isEmpty not ] ifNone: [ result addClass: aContext selectedClass instanceVariable: each ] ]. aContext selectedClass isMeta ifFalse: [ aContext selectedClass classPool associationsDo: [ :each | (aContext uses: each) ifFalse: [ result addClass: aContext selectedClass classVariable: each key ] ] ]! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variables not referenced'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for variables not referenced. If a variable is not used in a class, it should be deleted.'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'! severity ^ #information! ! RBBlockLintRule subclass: #RBUsesTrueRule instanceVariableNames: 'trueBinding falseBinding' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUsesTrueRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | method | method := aContext compiledMethod. ((method refersToLiteral: trueBinding) or: [ method refersToLiteral: falseBinding ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result searchStrings: #('True' 'False' ) ]! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBUsesTrueRule methodsFor: 'initialization' stamp: 'lr 7/23/2010 08:04'! initialize super initialize. trueBinding := Smalltalk globals associationAt: #True. falseBinding := Smalltalk globals associationAt: #False! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses True/False instead of true/false'! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for uses of the classes True and False instead of the objects true and false.'! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBUtilityMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBUtilityMethodsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass isMeta or: [ aContext selector numArgs == 0 or: [ (aContext protocols detect: [ :each | (self utilityProtocols detect: [ :protocol | protocol match: each ] ifNone: [ ]) notNil ] ifNone: [ ]) notNil ] ]) ifFalse: [ (self subclassOf: aContext selectedClass overrides: aContext selector) ifFalse: [ (aContext superMessages isEmpty and: [ aContext selfMessages isEmpty ]) ifTrue: [ (aContext selectedClass allInstVarNames , aContext selectedClass allClassVarNames asArray , #('self' ) detect: [ :each | aContext parseTree references: each ] ifNone: [ ]) isNil ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ] ] ]! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Utility methods'! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'List methods that have one or more arguments and do no refer to self or an instance variable. These methods might be better defined in some other class or as class methods.'! ! !RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'! subclassOf: aClass overrides: aSelector ^(aClass subclasses detect: [:each | (each includesSelector: aSelector) or: [self subclassOf: each overrides: aSelector]] ifNone: [nil]) notNil! ! !RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'! utilityProtocols ^ #('*utilit*')! ! RBBlockLintRule subclass: #RBVariableAssignedLiteralRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBVariableAssignedLiteralRule methodsFor: 'running' stamp: 'lr 11/2/2009 00:14'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext selectedClass instVarNames do: [ :each | | defClass selector | (allSubclasses inject: 0 into: [ :sum :class | | sels | sels := class whichSelectorsAssign: each. sels size == 1 ifTrue: [ selector := sels asArray first. defClass := class ]. sum + sels size ]) == 1 ifTrue: [ | tree searcher | searcher := RBParseTreeSearcher new. searcher matches: each , ' := ``@object' do: [ :aNode :answer | answer isNil and: [ aNode value isLiteral ] ]. tree := defClass parseTreeFor: selector. tree notNil ifTrue: [ (searcher executeTree: tree initialAnswer: nil) == true ifTrue: [ result addClass: aContext selectedClass instanceVariable: each ] ] ] ]! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable is only assigned a single literal value'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'If a variable is only assigned a single literal value then that variable is either nil or that literal value. If the variable is always initialized with that literal value, then you could replace each variable reference with a message send to get the value. If the variable can also be nil, then you might want to replace that variable with another that stores true or false depending on whether the old variable had been assigned.'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:32'! resultClass ^ RBVariableEnvironment! ! RBBlockLintRule subclass: #RBVariableNotDefinedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBVariableNotDefinedRule methodsFor: 'running' stamp: 'lr 7/23/2010 08:04'! checkMethod: aContext aContext compiledMethod literals do: [ :literal | (literal isVariableBinding and: [ literal key notNil ]) ifTrue: [ ((Smalltalk globals associationAt: literal key ifAbsent: [ ]) == literal or: [ (Undeclared associationAt: literal key ifAbsent: [ ]) == literal ]) ifFalse: [ (aContext selectedClass bindingOf: literal key) == literal ifFalse: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: literal key ] ] ] ]! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable used, but not defined anywhere'! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'This check is similar to the "References an undeclared variable" check, but it looks for variables that are not defined in the class or in the undeclared dictionary. You probably had to work hard to get your code in this state.'! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBBlockLintRule subclass: #RBVariableReferencedOnceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-BlockRules'! !RBVariableReferencedOnceRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext selectedClass instVarNames do: [ :each | | defClass selector | (allSubclasses inject: 0 into: [ :sum :class | | sels | sels := class whichSelectorsAccess: each. sels size == 1 ifTrue: [ selector := sels asArray first. defClass := class ]. sum + sels size ]) == 1 ifTrue: [ | tree | tree := defClass parseTreeFor: selector. tree notNil ifTrue: [ (RBReadBeforeWrittenTester isVariable: each writtenBeforeReadIn: tree) ifTrue: [ result addClass: defClass selector: selector. result addSearchString: each ] ] ] ]! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable referenced in only one method and always assigned first'! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for instance variables that might better be defined as temporary variables. If an instance variable is only used in one method and it is always assigned before it is used, then that method could define that variable as a temporary variable of the method instead (assuming that the method is not recursive).'! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'! severity ^ #information! ! RBBasicLintRule subclass: #RBParseTreeLintRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! RBParseTreeLintRule subclass: #RBAsOrderedCollectionNotNeededRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBAsOrderedCollectionNotNeededRule methodsFor: 'initialization' stamp: 'lr 5/15/2010 17:43'! initialize super initialize. self matcher matchesAnyOf: #( '`@node addAll: `{ :node | node isMessage and: [ #(asOrderedCollection asArray) includes: node selector ] }' '`@node withAll: `{ :node | node isMessage and: [ #(asOrderedCollection asArray) includes: node selector ] }' ) do: [ :node :answer | node ]! ! !RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '#asOrderedCollection/#asArray not needed'! ! !RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:44'! rationale ^ 'A prior convertion to an Array or OrderedCollection is not necessary when adding all elements to a collection.'! ! RBParseTreeLintRule subclass: #RBAssignmentInBlockRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBAssignmentInBlockRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:47'! initialize super initialize. self matcher matchesAnyOf: #( '`@cursor showWhile: [| `@temps | `@.Statements1. `var := `@object]' '`@cursor showWhile: [| `@temps | `@.Statements1. ^`@object]' '[| `@temps | `@.Statements. `var := `@object] ensure: `@block' '[| `@temps | `@.Statements. ^`@object] ensure: `@block' '[| `@temps | `@.Statements. `var := `@object] ifCurtailed: `@block' '[| `@temps | `@.Statements. ^`@object] ifCurtailed: `@block' ) do: [ :node :answer | node ]! ! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary assignment or return in block'! ! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:47'! rationale ^ 'Checks ensure:, ifCurtailed:, and showWhile: blocks for assignments or returns that are the last statement in the block. These assignments or returns can be moved outside the block since these messages return the value of the block.'! ! RBParseTreeLintRule subclass: #RBAssignmentWithoutEffectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! group ^ 'Unnecessary code'! ! !RBAssignmentWithoutEffectRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 13:56'! initialize super initialize. self matcher matches: '`var := `var' do: [ :node :answer | node ]! ! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! name ^ 'Assignment has no effect'! ! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! rationale ^ 'A statement such as x := x has no effect.'! ! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBParseTreeLintRule subclass: #RBBooleanPrecedenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBBooleanPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:18'! initialize super initialize. self matcher matchesAnyOf: #( '`@object1 | `@object2 = `@object3' '`@object1 | `@object2 == `@object3' '`@object1 & `@object2 = `@object3' '`@object1 & `@object2 == `@object3' '`@object1 | `@object2 ~= `@object3' '`@object1 | `@object2 ~~ `@object3' '`@object1 & `@object2 ~= `@object3' '`@object1 & `@object2 ~~ `@object3' ) do: [ :node :answer | node ]! ! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses A | B = C instead of A | (B = C)'! ! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks precedence ordering of & and | with equality operators. Since | and & have the same precedence as =, there are common mistakes where parenthesis are missing around the equality operators.'! ! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:03'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBCodeCruftLeftInMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:19'! initialize super initialize. self matcher matchesAnyOf: #( '`@object checkHaltCountExpired' '`@object clearHaltOnce' '`@object decrementAndCheckHaltCount' '`@object decrementHaltCount' '`@object doExpiredHaltCount' '`@object doExpiredHaltCount: `@object1' '`@object doOnlyOnce: `@object1' '`@object halt' '`@object halt: `@object1 onCount: `@object2' '`@object haltOnCount: `@object1' '`@object haltOnce' '`@object haltOnce: `@object1' '`@object haltOnceEnabled' '`@object hasHaltCount' '`@object hatIf: `@object1' '`@object inspectOnCount: `@object1' '`@object inspectOnce' '`@object inspectUntilCount: `@object1' '`@object rearmOneShot' '`@object removeHaltCount' '`@object setHaltCountTo: `@object1' '`@object setHaltOnce' '`@object toggleHaltOnce' '`@object flag: `@object1' '`@object isThisEverCalled' '`@object isThisEverCalled: `@object1' '`@object logEntry' '`@object logExecution' '`@object logExit' '`@object needsWork' 'true ifTrue: `@object1' 'false ifTrue: `@object1' 'true ifTrue: `@object1 ifFalse: `@object2' 'false ifTrue: `@object1 ifFalse: `@object2' 'true ifFalse: `@object1' 'false ifFalse: `@object1' 'true ifFalse: `@object1 ifTrue: `@object2' 'false ifFalse: `@object1 ifTrue: `@object2' 'Transcript `@message: `@object1' ) do: [ :node :answer | node ]! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Debugging code left in methods'! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Breakpoints, logging statements, etc. should not be left in production code.'! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:11'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBCollectSelectNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectSelectNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:20'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [(#(#select: #collect: #reject:) includes: node selector) and: [node isUsed not]]}' do: [ :node :answer | node ]! ! !RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a collect:/select:'! ! !RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:34'! rationale ^ 'Checks for senders of typical collection enumeration methods that return an unused result.'! ! RBParseTreeLintRule subclass: #RBCollectionMessagesToExternalObjectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'initialization' stamp: 'lr 7/23/2010 08:03'! initialize | queries | super initialize. queries := #( add: remove: addAll: removeAll: ) collect: [ :each | '(`@Object `@message: `@args) <1s> `@Arg' expandMacrosWith: each ]. self matcher matchesAnyOf: queries do: [ :node :answer | answer isNil ifTrue: [ ((node receiver selector copyFrom: 1 to: (node receiver selector size min: 2)) ~= 'as' and: [ | receiver | receiver := node receiver receiver. receiver isVariable not or: [ ((#('self' 'super') includes: receiver name) or: [ Smalltalk globals includesKey: receiver name asSymbol ]) not ] ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends add:/remove: to external collection'! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that appear to be modifying a collection that is owned by another object. Such modifications can cause problems especially if other variables are modified when the collection is modified. For example, CompositePart must set the container''s of all its parts when adding a new component.'! ! RBParseTreeLintRule subclass: #RBCollectionProtocolRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectionProtocolRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:23'! initialize super initialize. self matcher matchesAnyOf: #( '`@collection do: [:`each | | `@temps | `@.Statements1. `@object add: `@arg. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@blockTemps | `@.BlockStatements1. `@object add: `each. `@.BlockStatements2]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@blockTemps | `@.BlockStatements1. `@object add: `each. `@.BlockStatements2]. `@.Statements2]' ) do: [ :node :answer | node ]! ! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses do: instead of collect: or select:''s'! ! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using the do: method instead of using the collect: or select: methods. This often occurs with new people writing code. The collect: and select: variants express the source code''s intentions better.'! ! RBParseTreeLintRule subclass: #RBConsistencyCheckRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBConsistencyCheckRule methodsFor: 'initialization' stamp: 'lr 4/21/2012 20:29'! initialize super initialize. self matcher matchesAnyOf: #( '`@object = nil' '`@object == nil' '`@object ~= nil' '`@object ~~ nil' 'nil = `@object' 'nil == `@object' 'nil ~= `@object' 'nil ~~ `@object' '`@collection size = 0' '`@collection size == 0' '`@collection size ~= 0' '`@collection size ~~ 0' '`@collection size > 0' '`@collection size >= 1' '`@collection at: 1' '`@collection at: `@collection size' ) do: [ :node :answer | node ]! ! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses "size = 0", "= nil", or "at: 1" instead of "isEmpty", "isNil", or "first"'! ! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using equality tests instead of the message sends. Since the code "aCollection size = 0" works for all objects, it is more difficult for someone reading such code to determine that "aCollection" is a collection. Whereas, if you say "aCollection isEmpty" then aCollection must be a collection since isEmpty is only defined for collections.'! ! RBParseTreeLintRule subclass: #RBContainsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBContainsRule methodsFor: 'initialization' stamp: 'lr 4/21/2012 18:35'! initialize super initialize. self matcher matchesAnyOf: #( '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) isNil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) notNil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [`@expr]) = `@expr' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [`@expr]) == `@expr' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [`@expr]) ~= `@expr' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [`@expr]) ~~ `@expr' ) do: [ :node :answer | node ]! ! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 4/21/2012 17:38'! name ^ 'Uses detect:ifNone: instead of anySatsify:'! ! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 4/21/2012 18:40'! rationale ^ 'Checks for the common code fragment: "(aCollection detect: [ :each | ''some condition'' ] ifNone: [ nil ]) ~= nil". anySatsify: can simplify this code to "aCollection anySatsify: [ :each | ''some condition'' ]". Not only is the anySatsify: variant shorter, it better signifies what the code is doing.'! ! RBParseTreeLintRule subclass: #RBDetectContainsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBDetectContainsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:24'! initialize super initialize. self matcher matchesAnyOf: #( '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^`each]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^`each]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^true]. `@.Statements2]' '`@Collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^true]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^false]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^false]. `@.Statements2]' ) do: [ :node :answer | node ]! ! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses do: instead of contains: or detect:''s'! ! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using the do: method instead of using the contains: or detect: methods.'! ! RBParseTreeLintRule subclass: #RBEmptyExceptionHandlerRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:31'! group ^ 'Possible bugs'! ! !RBEmptyExceptionHandlerRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 14:12'! initialize super initialize. self matcher matches: '`@block on: `{ :node | | class | node isVariable and: [ (class := Smalltalk classNamed: node name) notNil and: [ (class includesBehavior: Exception) and: [ (class includesBehavior: Notification) not ] ] ] } do: [ :`@err | | `@temps | ]' do: [ :node :answer | node ]! ! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/9/2010 16:07'! name ^ 'Empty exception handler'! ! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 14:05'! rationale ^ 'Empty exception handler blocks hide potential bugs. The situation should be handled in a more robust way.'! ! RBParseTreeLintRule subclass: #RBEndTrueFalseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEndTrueFalseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher matchesAnyOf: #( '`@object ifTrue: [| `@temps1 | `@.Statements1. `.Statement] ifFalse: [| `@temps2 | `@.Statements2. `.Statement]' '`@object ifTrue: [| `@temps1 | `.Statement. `@.Statements1] ifFalse: [| `@temps2 | `.Statement. `@.Statements2]' '`@object ifFalse: [| `@temps1 | `@.Statements1. `.Statement] ifTrue: [| `@temps2 | `@.Statements2. `.Statement]' '`@object ifFalse: [| `@temps1 | `.Statement. `@.Statements1] ifTrue: [| `@temps2 | `.Statement. `@.Statement2]') do: [ :node :answer | answer isNil ifTrue: [ | statement | statement := node arguments first body statements last. (statement isVariable and: [ statement = node arguments last body statements last ]) ifFalse: [ node ] ifTrue: [ nil ] ] ifFalse: [ answer ] ]! ! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Check for same statements at end of ifTrue:ifFalse: blocks'! ! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end. While you might not originally write such code, as it is modified, it is easier to create such code. Instead of having the same code in two places, you should move it outside the blocks.'! ! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBParseTreeLintRule subclass: #RBEqualNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBEqualNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:26'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node isUsed not and: [#(#= #== #~= #~~ #< #> #<= #>=) includes: node selector]]}' do: [ :node :answer | node ]! ! !RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a =, ~=, etc.'! ! !RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:53'! rationale ^ 'Checks for senders of comparator messages that do not use the result.'! ! RBParseTreeLintRule subclass: #RBEqualsTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEqualsTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher matchesAnyOf: #('true' 'false') do: [ :node :answer | answer isNil ifTrue: [ (node parent isMessage and: [ #(#= #== #~= #~~) includes: node parent selector ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary "= true"'! ! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for a =, ==, ~=, or ~~ message being sent to true/false or with true/false as the argument. Many times these can be eliminated since their receivers are already booleans. For example, "anObject isFoo == false" could be replaced with "anObject isFoo not" if isFoo always returns a boolean. Sometimes variables might refer to true, false, and something else, but this is considered bad style since the variable has multiple types.'! ! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBParseTreeLintRule subclass: #RBExtraBlockRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBExtraBlockRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node receiver isBlock and: [node parent isCascade not and: [#(#value #value: #value:value: #value:value:value: #valueWithArguments) includes: node selector]]]}' do: [ :node :answer | node ]! ! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Block immediately evaluated'! ! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for blocks that are immediately evaluated. Since the block is immediately evaluated, there is no need for the statements to be in a block.'! ! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:09'! severity ^ #information! ! RBParseTreeLintRule subclass: #RBFileBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBFileBlocksRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:46'! initialize super initialize. self matcher matchesAnyOf: #( '[| `@temps | `var := `@object. `@.statements] ensure: [`var `@messages: `@args]' '[| `@temps | `var := `@object. `@.statements] ifCurtailed: [`var `@messages: `@args]' ) do: [ :node :answer | node ]! ! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Assignment inside unwind blocks should be outside.'! ! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks assignment to a variable that is the first statement inside the value block that is also used in the unwind block.'! ! RBParseTreeLintRule subclass: #RBFloatEqualityComparisonRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:57'! group ^ 'Possible bugs'! ! !RBFloatEqualityComparisonRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 14:03'! initialize super initialize. self matcher matchesAnyOf: #( '`{ :node | node isLiteral and: [ node value isFloat ] } = `@expr' '`{ :node | node isLiteral and: [ node value isFloat ] } ~= `@expr' '`@expr = `{ :node | node isLiteral and: [ node value isFloat ] }' '`@expr ~= `{ :node | node isLiteral and: [ node value isFloat ] }' ) do: [ :node :answer | node ]! ! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:58'! name ^ 'Float equality comparison'! ! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 14:03'! rationale ^ 'Floating point types are imprecise. Using the operators = or ~= might not yield the expected result due to internal rounding differences.'! ! RBParseTreeLintRule subclass: #RBGuardingClauseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBGuardingClauseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'! initialize super initialize. self matcher matchesAnyMethodOf: #( '`@MethodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' '`@MethodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' ) do: [ :node :answer | answer isNil ifTrue: [ node body statements last ] ifFalse: [ answer ] ]! ! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Guarding clauses'! ! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for ifTrue: or ifFalse: conditions at end of methods that have two or more statements inside their blocks. Such code might better represent the true meaning of the code if they returned self instead.'! ! RBParseTreeLintRule subclass: #RBIfTrueBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBIfTrueBlocksRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'! initialize super initialize. self matcher matchesAnyOf: #( '`@condition ifTrue: `{:node | node isBlock not} ifFalse: `@block' '`@condition ifTrue: `@block ifFalse: `{:node | node isBlock not}' '`@condition ifFalse: `{:node | node isBlock not} ifTrue: `@block' '`@condition ifFalse: `@block ifTrue: `{:node | node isBlock not}' '`@condition ifTrue: `{:node | node isBlock not}' '`@condition ifFalse: `{:node | node isBlock not}' '`@condition and: `{:node | node isBlock not}' '`@condition or: `{:node | node isBlock not}' '`{:node | node isBlock not} whileTrue' '`{:node | node isBlock not} whileFalse' '`{:node | node isBlock not} whileTrue: `@block' '`@block whileTrue: `{:node | node isBlock not}' '`{:node | node isBlock not} whileFalse: `@block' '`@block whileFalse: `{:node | node isBlock not}' '`@from to: `@to do: `{:node | node isBlock not}' '`@from to: `@to by: `@by do: `{:node | node isBlock not}' '`@condition ifNil: `{:node | node isBlock not}' '`@condition ifNotNil: `{:node | node isBlock not}' '`@condition ifNil: `{:node | node isBlock not} ifNotNil: `@block' '`@condition ifNil: `@block ifNotNil: `{:node | node isBlock not}' '`@condition ifNotNil: `{:node | node isBlock not} ifNil: `@block' '`@condition ifNotNil: `@block ifNil: `{:node | node isBlock not}' ) do: [ :node :answer | node ]! ! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Non-blocks in special messages'! ! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that don''t use blocks in the special messages. People new to Smalltalk might write code such as: "aBoolean ifTrue: (self doSomething)" instead of the correct version: "aBoolean ifTrue: [self doSomething]". Even if these pieces of code could be correct, they cannot be optimized by the compiler.'! ! RBParseTreeLintRule subclass: #RBIfTrueReturnsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBIfTrueReturnsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:30'! initialize super initialize. self matcher matchesAnyOf: #( '| `@temps | ``@.Statements. ``@object ifTrue: [^``@value1]. ^``@value2' '| `@temps | ``@.Statements. ``@object ifFalse: [^``@value1]. ^``@value2' ) do: [ :node :answer | answer isNil ifTrue: [ | condition | condition := (node statements at: node statements size - 1) arguments first body statements last value. "``@value1" ((condition isLiteral and: [ #(true false) includes: condition value ]) or: [ condition := node statements last value. condition isLiteral and: [ #(true false) includes: condition value ] ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'ifTrue:/ifFalse: returns instead of and:/or:''s'! ! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for common ifTrue: returns that could be simplified using a boolean expression.'! ! RBParseTreeLintRule subclass: #RBLawOfDemeterRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBLawOfDemeterRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:31'! initialize super initialize. self matcher matches: '(((`@reciver `@msg1: `@arg1) `@msg2: `@arg2) `@msg3: `@arg3) `@msg4: `@arg4' do: [ :node :answer | node ]! ! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Law of demeter'! ! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'The Law of Demeter is a design guideline for developing software and can be succinctly summarized as "Only talk to your immediate friends". The fundamental notion is that a given object should assume as little as possible about the structure or properties of anything else. If long method chains are used a lot of system knowledge is hardcoded into a single method and might make reusability difficult.'! ! RBParseTreeLintRule subclass: #RBLiteralArrayCharactersRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBLiteralArrayCharactersRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'! initialize super initialize. self matcher matches: '`#literal' do: [ :node :answer | answer isNil ifTrue: [ (node value class == Array and: [ self isArrayOfCharacters: node value ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBLiteralArrayCharactersRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:25'! isArrayOfCharacters: anArray anArray isEmpty ifTrue: [^false]. 1 to: anArray size do: [:each | (anArray at: each) class == Character ifFalse: [^false]]. ^true! ! !RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains only characters'! ! !RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:35'! rationale ^ 'Literal arrays containing only characters can more efficiently represented as strings.'! ! RBParseTreeLintRule subclass: #RBMissingTranslationsInMenusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMissingTranslationsInMenusRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 22:15'! initialize super initialize. self matcher matchesAnyOf: #( '`@menu add: `#label action: `#sym' '`@menu add: `#label selector: `#sym arguments: `@stuff' '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args' '`@menu add: `#label subMenu: `@stuff' '`@menu add: `#label target: `@targ action: `#sel' '`@menu add: `#label target: `@targ selector `#sel argument: `@arg' '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg' '`@menu add: `#label target: `@targ selector `#sel' '`@menu addList: `{ :n | n isLiteral and: [ n value isArray and: [ n value anySatisfy: [ :row | (row isKindOf: Array) and: [ row first isLiteral ] ] ] ] }' '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ' '`@menu addTitle: `#label' '`@menu addWithLabel: `#label enablement: `#esel action: `#sel' '`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args' '`@menu balloonTextForLastItem: `#label' '`@menu labels: `#lit lines: `@lines selections: `@sels' '`@menu title: `#title' ) do: [ :node :answer | node ]! ! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Menus missing translations'! ! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Literal strings shown to users in menus should be translated.'! ! RBParseTreeLintRule subclass: #RBMissingYourselfRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBMissingYourselfRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node parent isCascade and: [node isDirectlyUsed and: [node selector ~~ #yourself]]]}' do: [ :node :answer | node ]! ! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Possible missing "; yourself"'! ! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for missing "; yourself" cascaded message send for cascaded messages that are used. This helps locate common coding mistakes such as "anArray := (Array new: 2) at: 1 put: 1; at: 2 put: 2". In this example, anArray would be assigned to 2 not the array object.'! ! RBParseTreeLintRule subclass: #RBModifiesCollectionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBModifiesCollectionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher matchesAnyOf: #( '`@object do: [:`each | | `@temps | ``@.Statements]' '`@object collect: [:`each | | `@temps | ``@.Statements]' '`@object select: [:`each | | `@temps | ``@.Statements]' '`@object reject: [:`each | | `@temps | ``@.Statements]' '`@object inject: `@value into: [:`sum :`each | | `@temps | ``@.Statements]') do: [ :node :answer | answer isNil ifTrue: [ (self modifiesTree: node receiver in: node arguments last) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBModifiesCollectionRule methodsFor: 'private' stamp: 'TestRunner 11/3/2009 16:33'! modifiesTree: aCollectionTree in: aParseTree | notifier args | notifier := RBParseTreeSearcher new. args := Array with: (RBPatternVariableNode named: '`@object'). notifier matchesAnyTreeOf: (#(add: addAll: remove: removeAll:) collect: [:each | RBMessageNode receiver: aCollectionTree selector: each arguments: args]) do: [:aNode :answer | true]. ^notifier executeTree: aParseTree initialAnswer: false! ! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Modifies collection while iterating over it'! ! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for remove:''s of elements inside of collection iteration methods such as do:. These can cause the do: method to break since it will walk of the end of the collection. The common fix for this problem is to copy the collection before iterating over it.'! ! RBParseTreeLintRule subclass: #RBOnlyReadOrWrittenTemporaryRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'! group ^ 'Unnecessary code'! ! !RBOnlyReadOrWrittenTemporaryRule methodsFor: 'initialization' stamp: 'lr 6/4/2010 14:31'! initialize super initialize. self matcher matches: '| `@temps | ``@.stmts' do: [ :sequence :answer | answer isNil ifFalse: [ answer ] ifTrue: [ sequence temporaries detect: [ :temp | | isRead isWritten | isRead := false. isWritten := false. sequence statements do: [ :statement | statement nodesDo: [ :node | (node isVariable and: [ node name = temp name ]) ifTrue: [ isRead := isRead or: [ node isUsed ]. isWritten := isWritten or: [ node isWrite ] ] ] ]. (isRead and: [ isWritten ]) not ] ifNone: [ nil ] ] ]! ! !RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'! name ^ 'Temporary variables not read AND written'! ! !RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:11'! rationale ^ 'Checks that all temporary variables are both read and written. If an temporary variable is only read, you can replace all of the reads with nil, since it couldn''t have been assigned a value. If the variable is only written, then we don''t need to store the result since we never use it.'! ! !RBOnlyReadOrWrittenTemporaryRule methodsFor: 'accessing' stamp: 'lr 6/4/2010 12:10'! severity ^ #information! ! !RBParseTreeLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBParseTreeLintRule! ! !RBParseTreeLintRule methodsFor: 'running' stamp: 'lr 2/24/2009 08:21'! checkMethod: aContext (self matcher canMatchMethod: aContext compiledMethod) ifFalse: [ ^ self ]. (self matcher executeTree: aContext parseTree initialAnswer: nil) isNil ifFalse: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBParseTreeLintRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new! ! !RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 00:01'! matcher ^ matcher! ! !RBParseTreeLintRule methodsFor: 'running' stamp: 'lr 2/24/2009 08:21'! resetResult super resetResult. self result matcher: self matcher! ! !RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! resultClass ^ RBParseTreeEnvironment! ! RBParseTreeLintRule subclass: #RBPlatformDependentUserInteractionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBPlatformDependentUserInteractionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher matchesAnyOf: #( 'FillInTheBlank multiLineRequest: `@object1 centerAt: `@object2 initialAnswer: `@object3 answerHeight: `@object4' 'FillInTheBlank request: `@object1 initialAnswer: `@object2 centerAt: `@object3' 'FillInTheBlank request: `@object1 initialAnswer: `@object2' 'FillInTheBlank request: `@object1' 'FillInTheBlank requestPassword: `@object1' 'PopUpMenu confirm: `@object1 orCancel: `@object2' 'PopUpMenu confirm: `@object1 trueChoice: `@object2 falseChoice: `@object3' 'PopUpMenu confirm: `@object1' 'PopUpMenu inform: `@object1' 'PopUpMenu initialize' 'PopUpMenu labelArray: `@object1 lines: `@object2' 'PopUpMenu labelArray: `@object1' 'PopUpMenu labels: `@object1 lines: `@object2' 'PopUpMenu labels: `@object1' 'PopUpMenu withCaption: `@object1 chooseFrom: `@object2' 'SelectionMenu fromArray: `@object1' 'SelectionMenu labelList: `@object1 lines: `@object2 selections: `@object3' 'SelectionMenu labelList: `@object1 lines: `@object2' 'SelectionMenu labelList: `@object1 selections: `@object2' 'SelectionMenu labelList: `@object1' 'SelectionMenu labels: `@object1 lines: `@object2 selections: `@object3' 'SelectionMenu labels: `@object1 lines: `@object2' 'SelectionMenu labels: `@object1 selections: `@object2' 'SelectionMenu selections: `@object1 lines: `@object2' 'SelectionMenu selections: `@object1' ) do: [ :node :answer | node ]! ! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Platform dependent user interaction'! ! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'The method uses platform dependent user interactions.'! ! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:12'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBPrecedenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node hasParentheses not and: [#(#+ #-) includes: node selector]]} * `@C' do: [ :node :answer | node ]! ! !RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Inspect instances of "A + B * C" might be "A + (B * C)"'! ! !RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:45'! rationale ^ 'Checks for mathematical expressions that might be evaluated different (from left-to-right) than the developer thinks.'! ! RBParseTreeLintRule subclass: #RBReturnInEnsureRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnInEnsureRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:48'! initialize | returnMatcher | super initialize. returnMatcher := RBParseTreeSearcher new. returnMatcher matches: '^ `@object' do: [ :node :answer | true ]. self matcher matchesAnyOf: #( '``@rcv ensure: [| `@temps | ``@.Stmts]' '``@rcv ifCurtailed: [| `@temps | ``@.Stmts]') do: [ :node :answer | answer isNil ifTrue: [ (returnMatcher executeTree: node arguments first initialAnswer: false) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Contains a return in an ensure: block'! ! !RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:51'! rationale ^ 'Checks for return statements within ensure: blocks that can have unintended side-effects.'! ! RBParseTreeLintRule subclass: #RBReturnsIfTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnsIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:34'! initialize super initialize. self matcher matchesAnyOf: #( '^`@condition ifTrue: [| `@temps | `@.statements]' '^`@condition ifFalse: [| `@temps | `@.statements]' ) do: [ :node :answer | node ]! ! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Returns value of ifTrue:/ifFalse: without ifFalse:/ifTrue: block'! ! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that return the value of an ifTrue: or ifFalse: message. These statements return nil when the block is not executed.'! ! RBParseTreeLintRule subclass: #RBSearchingLiteralRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBSearchingLiteralRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:35'! initialize super initialize. self matcher matchesAnyOf: #( '``@object = `#literal or: [``@expression]' '``@object == `#literal or: [``@expression]' '`#literal = ``@object or: [``@expression]' '`#literal == ``@object or: [``@expression]' '``@expression | (``@object = `#literal)' '``@expression | (``@object == `#literal)' '``@expression | (`#literal = ``@object)' '``@expression | (`#literal == ``@object)') do: [ :node :answer | answer isNil ifTrue: [ (self isSearchingLiteralExpression: node) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBSearchingLiteralRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:26'! isSearchingLiteralExpression: aMessageNode | equalNode expressionNode | equalNode := aMessageNode selector = #| ifTrue: [aMessageNode arguments first] ifFalse: [aMessageNode receiver]. expressionNode := equalNode receiver isLiteral ifTrue: [equalNode arguments first] ifFalse: [equalNode receiver]. ^self isSearchingLiteralExpression: aMessageNode for: expressionNode! ! !RBSearchingLiteralRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:26'! isSearchingLiteralExpression: aSearchingNode for: anObjectNode | argument arguments | aSearchingNode isMessage ifFalse: [^false]. arguments := aSearchingNode arguments. arguments size = 1 ifFalse: [^false]. argument := arguments first. (#(#= #==) includes: aSearchingNode selector) ifTrue: [^(aSearchingNode receiver = anObjectNode and: [aSearchingNode arguments first isLiteral]) or: [aSearchingNode arguments first = anObjectNode and: [aSearchingNode receiver isLiteral]]]. aSearchingNode selector = #| ifTrue: [^(self isSearchingLiteralExpression: aSearchingNode receiver for: anObjectNode) and: [self isSearchingLiteralExpression: argument for: anObjectNode]]. aSearchingNode selector = #or: ifFalse: [^false]. argument isBlock ifFalse: [^false]. argument body statements size = 1 ifFalse: [^false]. ^(self isSearchingLiteralExpression: aSearchingNode receiver for: anObjectNode) and: [self isSearchingLiteralExpression: argument body statements first for: anObjectNode]! ! !RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses or''s instead of a searching literal'! ! !RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:38'! rationale ^ 'Checks for repeated literal equalitity tests that should rather be implemented as a search in a literal collection.'! ! RBParseTreeLintRule subclass: #RBSendsDeprecatedMethodToGlobalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'initialization' stamp: 'lr 9/8/2011 20:25'! initialize | patterns pattern wellKnownGlobals | super initialize. patterns := OrderedCollection new. wellKnownGlobals := IdentityDictionary new. Smalltalk globals keysAndValuesDo: [ :name :object | (object isBehavior or: [ object isTrait ]) ifFalse: [ (wellKnownGlobals at: object class ifAbsentPut: [ IdentitySet new ]) add: name ] ]. self selectors do: [ :symbol | (RBBrowserEnvironment new referencesTo: symbol) classesAndSelectorsDo: [ :class :selector | class isMeta ifTrue: [ class withAllSubclassesDo: [ :subclass | patterns add: (String streamContents: [ :stream | stream nextPutAll: subclass theNonMetaClass name; nextPutAll: (self genericPatternForSelector: selector) ]) ] ] ifFalse: [ wellKnownGlobals keysAndValuesDo: [ :global :names | (global includesBehavior: class) ifTrue: [ names do: [ :each | patterns add: (String streamContents: [ :stream | stream nextPutAll: each; nextPutAll: (self genericPatternForSelector: selector) ]) ] ] ] ] ] ]. self matcher matchesAnyOf: patterns do: [ :node :answer | node ]! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends a deprecated message to a known global'! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:49'! rationale ^ 'Checks for sends of deprecated messages that might be removed in upcoming releases of Pharo.'! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 9/4/2010 14:04'! selectors ^ #(deprecated: deprecated:on:in: deprecated:explanation: deprecated:block: greaseDeprecatedApi:details:)! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:12'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBSendsUnknownMessageToGlobalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'initialization' stamp: 'lr 8/15/2010 17:17'! initialize super initialize. self matcher matches: '`{:node :context | node isVariable and: [ Smalltalk includesKey: node name asSymbol ] } `@message: `@args' do: [ :node :answer | answer isNil ifTrue: [ | what | what := Smalltalk globals at: node receiver name asSymbol. (what notNil and: [ (what respondsTo: node selector) not ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends unknown message to global'! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:32'! rationale ^ 'Checks for messages that are sent but not implemented by a global. Reported methods will certainly cause a doesNotUnderstand: message when they are executed.'! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:04'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBSizeCheckRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBSizeCheckRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:46'! initialize | patterns | super initialize. patterns := OrderedCollection new. patterns addAll: (self selectors collect: [ :each | '`@object size > 0 ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object isEmpty ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object notEmpty ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object size = 0 ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). self matcher matchesAnyOf: patterns do: [ :node :answer | node ]! ! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary size check'! ! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for code that checks that a collection is non-empty before sending it an iteration message (e.g., do:, collect:, etc.). Since the collection iteration messages work for empty collections, we do not need to clutter up our method with the extra size check.'! ! !RBSizeCheckRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:47'! selectors ^ #( collect: do: reject: select: )! ! RBParseTreeLintRule subclass: #RBStringConcatenationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBStringConcatenationRule methodsFor: 'initialization' stamp: 'lr 6/4/2010 12:03'! initialize | concatenationMatcher | super initialize. concatenationMatcher := RBParseTreeSearcher new. concatenationMatcher matches: '`@receiver , `@argument' do: [ :node :answer | true ]. self matcher matchesAnyOf: #( '``@collection do: ``@argument' '``@collection do: ``@argument1 separatedBy: ``@argument2' '``@start to: ``@stop do: ``@argument' '``@collection detect: ``@argument' '``@collection detect: ``@argument1 ifNone: ``@argument2' '``@collection select: ``@argument' '``@collection reject: ``@argument' '``@collection inject: ``@value into: ``@argument' '``@collection anySatisfy: ``@argument' '``@collection allSatisfy: ``@argument' '``@collection noneSatisfy: ``@argument' ) do: [ :node :answer | answer isNil ifTrue: [ (node arguments detect: [ :each | each isBlock and: [ concatenationMatcher executeTree: each initialAnswer: false ] ] ifNone: [ nil ]) notNil ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'String concatenation instead of streams'! ! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for people using string concatenation inside some iteration message. Since string concatenation is O(n^2), it is better to use streaming since it is O(n) - assuming that n is large enough.'! ! RBParseTreeLintRule subclass: #RBThreeElementPointRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBThreeElementPointRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'! initialize super initialize. self matcher matches: '``@x @ ``@y' do: [ :node :answer | answer isNil ifTrue: [ | current | current := node parent. [ current isNil or: [ current isMessage and: [ current selector = #@ or: [ current selector isInfix not ] ] ] ] whileFalse: [ current := current parent ]. (current isNil or: [ current isMessage and: [ current selector isInfix not ] ]) ifTrue: [ nil ] ifFalse: [ node ] ] ifFalse: [ answer ] ]! ! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Possible three element point (e.g., x @ y + q @ r)'! ! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks arithmetic statements for possible three element points (i.e., a point that has another point in its x or y part).'! ! RBParseTreeLintRule subclass: #RBToDoCollectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoCollectRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'! initialize super initialize. self matcher matchesAnyOf: #( '| `@temps1 | `@.Stmts1. `collection := Array new: `@size. `@.Stmts2. 1 to: `@size do: [:`i | | `@Btemps2 | `@.BStmts1. `collection at: `i put: `@obj. `@.BStmt2]. `@.Stmts3' '| `@temps1 | `@.Stmts1. `collection := Array new: `@size. `@.Stmts2. 1 to: `collection size do: [:`i | | `@Btemps2 | `@.BStmts1. `collection at: `i put: `@obj. `@.BStmt2]. `@.Stmts3' ) do: [ :node :answer | node ]! ! !RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'to:do: doesn''t use collect:'! ! !RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:39'! rationale ^ 'Checks for users of to:do: when the shorter collect: would work.'! ! RBParseTreeLintRule subclass: #RBToDoRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 23:38'! initialize super initialize. self matcher matches: '1 to: ``@object size do: [:`each | | `@temps | `@.Statements]' do: [ :node :answer | answer isNil ifTrue: [ | varName variableMatcher | varName := node arguments last arguments first. "`each" variableMatcher := RBParseTreeSearcher new. variableMatcher matchesTree: varName do: [ :nod :ans | ans and: [ nod parent isMessage and: [ nod parent selector = #at: ] ] ]. (variableMatcher executeTree: node arguments last body initialAnswer: true) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses to:do: instead of do:, with:do: or timesRepeat:'! ! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using to:do: when a do:, with:do: or timesRepeat: should be used.'! ! RBParseTreeLintRule subclass: #RBToDoWithIncrementRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoWithIncrementRule methodsFor: 'initialization' stamp: 'lr 5/15/2010 17:41'! initialize super initialize. self matcher matchesAnyOf: #( '`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x + 1. `@.Stmts2]' '`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x + `@k. `@.Stmts2]' '`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x - 1. `@.Stmts2]' '`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x - `@k. `@.Stmts2]') do: [ :node :answer | node ]! ! !RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'to:do: loop also increments a counter'! ! !RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:42'! rationale ^ 'Checks for users of to:do: that also increment or decrement a counter.'! ! RBParseTreeLintRule subclass: #RBUnconditionalRecursionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBUnconditionalRecursionRule methodsFor: 'initialization' stamp: 'lr 5/15/2010 18:09'! initialize super initialize. self matcher matchesMethod: '`@message: `@args | `@temps | `@.before. self `@message: `@args. `@.after' do: [ :node :answer | | index | index := node body statements findFirst: [ :each | each isMessage and: [ each selector = node selector ] ]. ((node body statements copyFrom: 1 to: index) anySatisfy: [ :each | each containsReturn ]) ifTrue: [ answer ] ifFalse: [ node ] ]! ! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unconditional recursion'! ! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:55'! rationale ^ 'Checks for unconditional recursion that might cause the image to hang when executed.'! ! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:55'! severity ^ #error! ! RBParseTreeLintRule subclass: #RBUnnecessaryAssignmentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! group ^ 'Unnecessary code'! ! !RBUnnecessaryAssignmentRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '^`{:aNode | aNode isAssignment and: [(aNode whoDefines: aNode variable name) notNil]}' do: [ :node :answer | node ]! ! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! name ^ 'Unnecessary assignment to a temporary variable'! ! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 18:04'! rationale ^ 'Checks for assignements to temporaries that are not used afterwards.'! ! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:10'! severity ^ #information! ! RBParseTreeLintRule subclass: #RBUnoptimizedAndOrRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnoptimizedAndOrRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matchesAnyOf: #( '(`@a and: `@b) and: `@c' '(`@a or: `@b) or: `@c' ) do: [ :node :answer | node ]! ! !RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses "(a and: [b]) and: [c]" instead of "a and: [b and: [c]]"'! ! !RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:46'! rationale ^ 'Checks for inefficient nesting of logical conditions.'! ! RBParseTreeLintRule subclass: #RBUnoptimizedToDoRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnoptimizedToDoRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '(`@a to: `@b) do: `@c' do: [ :node :answer | node ]! ! !RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses (to:)do: instead of to:do:'! ! !RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:48'! rationale ^ 'Checks for inefficient uses of to:do: that create an unnecessary Interval instance.'! ! RBParseTreeLintRule subclass: #RBUsesAddRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBUsesAddRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [(node selector == #add: or: [node selector == #addAll:]) and: [node isDirectlyUsed]]}' do: [ :node :answer | node ]! ! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses the result of an add: message'! ! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for possible uses of the result returned by an add: or addAll: messages. These messages return their arguments not the receiver. As a result, may uses of the results are wrong.'! ! RBParseTreeLintRule subclass: #RBWhileTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBWhileTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matchesAnyOf: #( '| `@temps | `@.Statements1. [`index <= `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index + 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index < `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index + 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index >= `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index - 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index > `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index - 1]. `@.Statements2' ) do: [ :node :answer | node ]! ! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses whileTrue: instead of to:do:'! ! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 17:39'! rationale ^ 'Checks for users of whileTrue: when the shorter to:do: would work.'! ! RBParseTreeLintRule subclass: #RBYourselfNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-ParseTreeRules'! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBYourselfNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:54'! initialize super initialize. self matcher matches: '`{:node | node parent isUsed not} yourself' do: [ :node :answer | node ]! ! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a yourself message'! ! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods sending the yourself message when it is not necessary.'! ! RBLintRule subclass: #RBCompositeLintRule instanceVariableNames: 'rules name' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:50'! allRules ^ self rules: (Array with: self lintChecks with: self transformations) name: 'All checks'! ! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'! lintChecks ^ self rules: (self rulesGroupedFor: RBBasicLintRule) name: 'Lint checks'! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:55'! rules: aCollection ^ self new rules: aCollection; yourself! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:56'! rules: aCollection name: aString ^ self new rules: aCollection; name: aString; yourself! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/24/2009 17:11'! rulesFor: aRuleClass | rules | rules := SortedCollection sortBlock: [ :a :b | a name <= b name ]. aRuleClass withAllSubclassesDo: [ :each | each isVisible ifTrue: [ rules add: each new ] ]. ^ rules asArray! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 22:44'! rulesGroupedFor: aRuleClass | groups rules | groups := Dictionary new. (self rulesFor: aRuleClass) do: [ :each | (groups at: each group ifAbsentPut: [ OrderedCollection new ]) addLast: each ]. rules := SortedCollection sortBlock: [ :a :b | a name <= b name ]. groups keysAndValuesDo: [ :group :elements | rules addLast: (RBCompositeLintRule rules: elements asArray name: group) ]. ^ rules asArray! ! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'! transformations ^ self rules: (self rulesGroupedFor: RBTransformationRule) name: 'Transformations'! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:09'! changes ^ rules gather: [ :each | each changes ]! ! !RBCompositeLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:10'! checkClass: aContext rules do: [ :each | each checkClass: aContext ]! ! !RBCompositeLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:10'! checkMethod: aContext rules do: [ :each | each checkMethod: aContext ]! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'! hasConflicts ^ rules anySatisfy: [ :each | each hasConflicts ]! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'! isComposite ^ true! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:12'! isEmpty ^ rules allSatisfy: [ :each | each isEmpty ]! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'! name ^ name! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:33'! name: aString name := aString! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'! problemCount ^ rules inject: 0 into: [ :count :each | count + each problemCount ]! ! !RBCompositeLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:11'! resetResult rules do: [ :each | each resetResult ]! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'! rules ^ rules! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'! rules: aCollection rules := aCollection! ! !RBLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:08'! isVisible "Answer true if the class should be visible in the GUI." ^ false! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:29'! changes ^ #()! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:02'! checkClass: aContext! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:03'! checkMethod: aContext! ! !RBLintRule methodsFor: 'private' stamp: 'lr 2/24/2009 15:46'! genericPatternForSelector: aSymbol ^ String streamContents: [ :stream | aSymbol keywords keysAndValuesDo: [ :index :value | stream space; nextPutAll: value. aSymbol last = $: ifTrue: [ stream space; nextPutAll: '`@object'; print: index ] ] ]! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 14:59'! group "Answer a human readable group name of this rule." ^ String new! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'! hasConflicts ^ false! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'! isComposite ^ false! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:51'! isEmpty self subclassResponsibility! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 14:58'! name "Answer a human readable name of the rule." self subclassResponsibility! ! !RBLintRule methodsFor: 'printing' stamp: 'lr 2/26/2009 16:06'! printOn: aStream super printOn: aStream. self name isNil ifFalse: [ aStream nextPutAll: ' name: '; print: self name ]! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:41'! problemCount self subclassResponsibility! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 14:59'! rationale "Answer a detailled explanation of the rule." ^ String new! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:35'! resetResult! ! !RBLintRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:15'! run ^ RBSmalllintChecker runRule: self! ! !RBLintRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:15'! runOnEnvironment: anEnvironment ^ RBSmalllintChecker runRule: self onEnvironment: anEnvironment! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 5/15/2010 15:01'! severity "Answer the severity of issues reported by this rule. This method should return one of #error, #warning, or #information." ^ #warning! ! RBLintRule subclass: #RBTransformationRule instanceVariableNames: 'rewriteRule builder class' classVariableNames: 'RecursiveSelfRule' poolDictionaries: '' category: 'Refactoring-Critics'! RBTransformationRule subclass: #RBAllAnyNoneSatisfyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:35'! group ^ 'Transformations'! ! !RBAllAnyNoneSatisfyRule methodsFor: 'initialization' stamp: 'lr 1/3/2010 12:04'! initialize super initialize. self rewriteRule " allSatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifFalse: [ ^ false ] ]. ^ true' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection allSatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'; " anySatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifTrue: [ ^ true ] ]. ^ false' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection anySatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'; " noneSatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifTrue: [ ^ false ] ]. ^ true' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection noneSatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'! ! !RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:53'! name ^ 'Replace with #allSatsify:, #anySatisfy: or #noneSatsify:'! ! RBTransformationRule subclass: #RBAssignmentInIfTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBAssignmentInIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:24'! initialize super initialize. self rewriteRule replace: '``@Boolean ifTrue: [`variable := ``@true] ifFalse: [`variable := ``@false]' with: '`variable := ``@Boolean ifTrue: [``@true] ifFalse: [``@false]'; replace: '``@Boolean ifFalse: [`variable := ``@true] ifTrue: [`variable := ``@false]' with: '`variable := ``@Boolean ifFalse: [``@true] ifTrue: [``@false]'! ! !RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Move variable assignment outside of single statement ifTrue:ifFalse: blocks'! ! !RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 9/7/2010 20:25'! rationale ^ 'Moving assignements outside blocks leads to shorter and more efficient code.'! ! RBTransformationRule subclass: #RBAtIfAbsentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBAtIfAbsentRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:26'! initialize super initialize. self rewriteRule replace: '``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements1. ``@dictionary at: ``@key put: ``@object. ``@.Statements2. ``@object]' with: '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements1. ``@.Statements2. ``@object]'; replace: '``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements. ``@dictionary at: ``@key put: ``@object]' with: '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements. ``@object]'! ! !RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'at:ifAbsent: -> at:ifAbsentPut:'! ! !RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 9/7/2010 20:26'! rationale ^ 'The use of #at:ifAbsentPut: leads to more readable and faster code.'! ! RBTransformationRule subclass: #RBBetweenAndRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBBetweenAndRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'! initialize super initialize. self rewriteRule replace: '``@a >= ``@b and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c'! ! !RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '"a >= b and: [a <= c]" -> "a between: b and: c"'! ! RBTransformationRule subclass: #RBCascadedNextPutAllsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBCascadedNextPutAllsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'! initialize super initialize. self rewriteRule replace: '``@rcvr nextPutAll: ``@object1 , ``@object2' with: '``@rcvr nextPutAll: ``@object1; nextPutAll: ``@object2'; replace: '``@rcvr show: ``@object1 , ``@object2' with: '``@rcvr show: ``@object1; show: ``@object2'! ! !RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Use cascaded nextPutAll:''s instead of #, in #nextPutAll:'! ! RBTransformationRule subclass: #RBDetectIfNoneRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBDetectIfNoneRule methodsFor: 'initialization' stamp: 'lr 1/3/2010 11:56'! initialize super initialize. self rewriteRule replace: '``@collection contains: [:`each | | `@temps | ``@.Statements]' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) isNil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) = nil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) == nil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) notNil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~= nil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~~ nil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'! ! !RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:55'! name ^ '#detect:ifNone: -> anySatisfy:'! ! RBTransformationRule subclass: #RBEqualNilRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBEqualNilRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:31'! initialize super initialize. self rewriteRule replace: '``@object = nil' with: '``@object isNil'; replace: '``@object == nil' with: '``@object isNil'; replace: '``@object ~= nil' with: '``@object notNil'; replace: '``@object ~~ nil' with: '``@object notNil'! ! !RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '= nil -> isNil AND ~= nil -> notNil'! ! RBTransformationRule subclass: #RBGuardClauseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBGuardClauseRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:33'! initialize super initialize. self rewriteRule replaceMethod: '`@methodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@trueTemps | `.Statement1. `.Statement2. `@.Statements1]' with: '`@methodName: `@args | `@temps `@trueTemps | `@.Statements. `@condition ifFalse: [^self]. `.Statement1. `.Statement2. `@.Statements1'; replaceMethod: '`@methodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@falseTemps | `.Statement1. `.Statement2. `@.Statements1]' with: '`@methodName: `@args | `@temps `@falseTemps | `@.Statements. `@condition ifTrue: [^self]. `.Statement1. `.Statement2. `@.Statements1'! ! !RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Eliminate guarding clauses'! ! RBTransformationRule subclass: #RBMinMaxRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBMinMaxRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:35'! initialize super initialize. self rewriteRule replace: '``@a < ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b'; replace: '``@a <= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b'; replace: '``@a > ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b'; replace: '``@a >= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b'; replace: '``@a < ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b'; replace: '``@a <= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b'; replace: '``@a > ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b'; replace: '``@a >= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b'; replace: '`a < ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a <= ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a < ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a <= ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a > ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a >= ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a > ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a >= ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b < `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b <= `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b < `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b <= `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b > `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b >= `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b > `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b >= `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'! ! !RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Rewrite ifTrue:ifFalse: using min:/max:'! ! !RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 9/7/2010 20:27'! rationale ^ 'The use of the messages #min: and #max: improves code readability and avoids heavily nested conditionals.'! ! RBTransformationRule subclass: #RBNotEliminationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBNotEliminationRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:38'! initialize super initialize. self rewriteRule replace: '``@object not not' with: '``@object'; replace: '``@object not ifTrue: ``@block' with: '``@object ifFalse: ``@block'; replace: '``@object not ifFalse: ``@block' with: '``@object ifTrue: ``@block'; replace: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object not]' with: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object]'; replace: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object not]' with: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object]'; replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue: ``@block' with: '[| `@temps | ``@.Statements. ``@object] whileFalse: ``@block'; replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse: ``@block' with: '[| `@temps | ``@.Statements. ``@object] whileTrue: ``@block'; replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue' with: '[| `@temps | ``@.Statements. ``@object] whileFalse'; replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse' with: '[| `@temps | ``@.Statements. ``@object] whileTrue'; replace: '(``@a <= ``@b) not' with: '``@a > ``@b'; replace: '(``@a < ``@b) not' with: '``@a >= ``@b'; replace: '(``@a = ``@b) not' with: '``@a ~= ``@b'; replace: '(``@a == ``@b) not' with: '``@a ~~ ``@b'; replace: '(``@a ~= ``@b) not' with: '``@a = ``@b'; replace: '(``@a ~~ ``@b) not' with: '``@a == ``@b'; replace: '(``@a >= ``@b) not' with: '``@a < ``@b'; replace: '(``@a > ``@b) not' with: '``@a <= ``@b'! ! !RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Eliminate unnecessary not''s'! ! RBTransformationRule subclass: #RBSuperSendsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBSuperSendsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:44'! initialize super initialize. self rewriteRule replace: 'super `@message: ``@args' with: 'self `@message: ``@args' when: [ :node | (class withAllSubclasses detect: [:each | each includesSelector: node selector] ifNone: [ nil ]) isNil ]! ! !RBSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Rewrite super messages to self messages when both refer to same method'! ! !RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:48'! initialize self initializeRecursiveSelfRule! ! !RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initializeRecursiveSelfRule RecursiveSelfRule := RBParseTreeSearcher new. RecursiveSelfRule matchesAnyMethodOf: #( '`@methodName: `@args | `@temps | self `@methodName: `@args1' '`@methodName: `@args | `@temps | ^ self `@methodName: `@args1') do: [ :node :answer | true ]. ^ RecursiveSelfRule! ! !RBTransformationRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBTransformationRule! ! !RBTransformationRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:49'! recursiveSelfRule ^ RecursiveSelfRule! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:46'! changes ^ builder changes! ! !RBTransformationRule methodsFor: 'running' stamp: 'lr 11/1/2009 22:59'! checkMethod: aContext (self rewriteRule canMatchMethod: aContext compiledMethod) ifFalse: [ ^ self ]. class := aContext selectedClass. (self rewriteRule executeTree: aContext parseTree) ifTrue: [ (self class recursiveSelfRule executeTree: rewriteRule tree initialAnswer: false) ifFalse: [ builder compile: rewriteRule tree newSource in: class classified: aContext protocol ] ]! ! !RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'! hasConflicts ^ true! ! !RBTransformationRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. rewriteRule := RBParseTreeRewriter new! ! !RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'! isEmpty ^ builder changes isEmpty! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:46'! problemCount ^ builder problemCount! ! !RBTransformationRule methodsFor: 'running' stamp: 'lr 9/8/2011 20:10'! resetResult builder := RBCompositeRefactoryChange named: self name! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! result | environment | environment := RBParseTreeEnvironment new. environment matcher: self rewriteRule. environment label: self name. self changes do: [ :change | (change isKindOf: RBAddMethodChange) ifTrue: [ environment addClass: change changeClass selector: change selector ] ]. ^ environment! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:23'! rewriteRule ^ rewriteRule! ! RBTransformationRule subclass: #RBTranslateLiteralsInMenusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBTranslateLiteralsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBTranslateLiteralsInMenusRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:41'! initialize super initialize. self rewriteRule replace: '`@menu add: `#label action: `#sym' with: '`@menu add: `#label translated action: `#sym'; replace: '`@menu add: `#label selector: `#sym arguments: `@stuff' with: '`@menu add: `#label translated selector: `#sym arguments: `@stuff'; replace: '`@menu add: `#label subMenu: `@stuff' with: '`@menu add: `#label translated subMenu: `@stuff'; replace: '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args' with: '`@menu add: `#label translated subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args'; replace: '`@menu add: `#label target: `@targ action: `#sel' with: '`@menu add: `#label translated target: `@targ action: `#sel'; replace: '`@menu add: `#label target: `@targ selector `#sel' with: '`@menu add: `#label translated target: `@targ selector `#sel'; replace: '`@menu add: `#label target: `@targ selector `#sel argument: `@arg' with: '`@menu add: `#label translated target: `@targ selector `#sel argument: `@arg'; replace: '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg' with: '`@menu add: `#label translated target: `@targ selector `#sel arguments: `@arg'; replace: '`@menu addTitle: `#label' with: '`@menu addTitle: `#label translated'; replace: '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ' with: '`@menu addTitle: `#label translated updatingSelector: `#sel updateTarget: `@targ'; replace: '`@menu addWithLabel: `#label enablement: `#esel action: `#sel' with: '`@menu addWithLabel: `#label translated enablement: `#esel action: `#sel'; replace: '`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args' with: '`@menu addWithLabel: `#label translated enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args'; replace: '`@menu balloonTextForLastItem: `#label' with: '`@menu balloonTextForLastItem: `#label translated'; replace: '`@menu labels: `#lit lines: `@lines selections: `@sels' with: '`@menu labels: (`#lit collect: [ :l | l translated ]) lines: `@lines selections: `@sels'; replace: '`@menu title: `#title' with: '`@menu title: `#title translated'! ! !RBTranslateLiteralsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'add translations to strings in menus'! ! RBTransformationRule subclass: #RBUnderscoreAssignmentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:02'! group ^ 'Transformations'! ! !RBUnderscoreAssignmentRule methodsFor: 'initialization' stamp: 'lr 11/7/2009 18:31'! initialize super initialize. self rewriteRule replace: '`var := ``@object' with: '`var := ``@object' when: [ :node | node assignmentOperator = '_' ]! ! !RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:05'! name ^ 'Underscore assignements should be avoided'! ! RBTransformationRule subclass: #RBUnwindBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics-TransformationRules'! !RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBUnwindBlocksRule methodsFor: 'initialization' stamp: 'lr 11/4/2009 09:26'! initialize super initialize. self rewriteRule replace: '[| `@temps | ``@.Statements. `var := ``@object] ensure: ``@block' with: '`var := [| `@temps | ``@.Statements. ``@object] ensure: ``@block'; replace: '[| `@temps | ``@.Statements. ^``@object] ensure: ``@block' with: '^[| `@temps | ``@.Statements. ``@object] ensure: ``@block'; replace:'[| `@temps | ``@.Statements. `var := ``@object] ifCurtailed: ``@block' with: '`var := [| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'; replace:'[| `@temps | ``@.Statements. ^``@object] ifCurtailed: ``@block' with: '^[| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'! ! !RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:41'! name ^ 'Move assignment out of unwind blocks'! ! Object subclass: #RBSmalllintChecker instanceVariableNames: 'rule environment context methodBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBSmalllintChecker class methodsFor: 'instance creation' stamp: 'lr 9/8/2011 20:15'! newWithContext ^(self new) context: RBSmalllintContext new; yourself! ! !RBSmalllintChecker class methodsFor: 'instance creation' stamp: 'nk 11/12/2002 13:12'! runRule: aLintRule (self new) rule: aLintRule; run. ^aLintRule! ! !RBSmalllintChecker class methodsFor: 'instance creation' stamp: ''! runRule: aLintRule onEnvironment: aBrowserEnvironment (self new) rule: aLintRule; environment: aBrowserEnvironment; run. ^aLintRule! ! !RBSmalllintChecker methodsFor: 'private' stamp: ''! checkClass: aClass context selectedClass: aClass. (environment definesClass: aClass) ifTrue: [rule checkClass: context]! ! !RBSmalllintChecker methodsFor: 'private' stamp: ''! checkMethodsForClass: aClass ^environment selectorsForClass: aClass do: [:each | context selector: each. rule checkMethod: context. methodBlock value]! ! !RBSmalllintChecker methodsFor: 'accessing' stamp: ''! context: aSmalllintContext context := aSmalllintContext! ! !RBSmalllintChecker methodsFor: 'accessing' stamp: ''! environment: aBrowserEnvironment environment := aBrowserEnvironment! ! !RBSmalllintChecker methodsFor: 'initialize-release' stamp: 'lr 9/8/2011 20:32'! initialize methodBlock := []. environment := RBSelectorEnvironment new. context := RBSmalllintContext newNoCache! ! !RBSmalllintChecker methodsFor: 'accessing' stamp: ''! methodBlock: aBlock methodBlock := aBlock! ! !RBSmalllintChecker methodsFor: 'initialize-release' stamp: ''! release context release. super release! ! !RBSmalllintChecker methodsFor: 'accessing' stamp: ''! rule: aLintRule rule := aLintRule! ! !RBSmalllintChecker methodsFor: 'actions' stamp: 'lr 1/21/2010 23:43'! run rule resetResult. environment classesDo: [ :class | class isTrait ifFalse: [ self checkClass: class. self checkMethodsForClass: class ] ]! ! Object subclass: #RBSmalllintContext instanceVariableNames: 'class selector parseTree literals literalSemaphore literalProcess selectors compiledMethod selfMessages superMessages messages' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Critics'! !RBSmalllintContext class methodsFor: 'instance creation' stamp: ''! newNoCache ^self basicNew! ! !RBSmalllintContext methodsFor: 'private' stamp: 'lr 2/5/2010 15:50'! addLiteralsFor: aCompiledMethod 2 to: aCompiledMethod numLiterals - 1 do: [ :index | self checkLiteral: (aCompiledMethod objectAt: index) ]! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! buildParseTree | tree | tree := self selectedClass parseTreeFor: self selector. tree isNil ifTrue: [^RBParser parseMethod: 'method']. ^tree! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! checkLiteral: aLiteral (aLiteral isSymbol or: [aLiteral isVariableBinding]) ifTrue: [literals add: aLiteral] ifFalse: [aLiteral class == Array ifTrue: [aLiteral do: [:each | self checkLiteral: each]]]! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! compiledMethod ^compiledMethod notNil ifTrue: [compiledMethod] ifFalse: [compiledMethod := class compiledMethodAt: selector]! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! computeLiterals literalSemaphore := Semaphore new. literalProcess := [self primitiveComputeLiterals] fork! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! computeLiteralsForClass: aClass (selectors addAll: aClass selectors) do: [:sel | self computeLiteralsForSelector: sel in: aClass. Processor yield]! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! computeLiteralsForSelector: aSelector in: aClass | method | method := aClass compiledMethodAt: aSelector ifAbsent: [nil]. method isNil ifTrue: [^self]. self addLiteralsFor: method! ! !RBSmalllintContext methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! computeMessages | searcher | selfMessages := Set new. superMessages := Set new. messages := Set new. searcher := RBParseTreeSearcher new. searcher matches: 'self `@message: ``@args' do: [:aNode :answer | selfMessages add: aNode selector]; matches: 'super `@message: ``@args' do: [:aNode :answer | superMessages add: aNode selector]; matches: '``@receiver `@message: ``@args' do: [:aNode :answer | messages add: aNode selector]. searcher executeTree: self parseTree initialAnswer: nil! ! !RBSmalllintContext methodsFor: 'testing' stamp: ''! implements: aSelector ^self selectors includes: aSelector! ! !RBSmalllintContext methodsFor: 'testing' stamp: 'lr 3/7/2011 21:40'! includesBehaviorNamed: aClassName | current | current := self selectedClass. [ current isNil ] whileFalse: [ current name = aClassName ifTrue: [ ^ true ]. current := current superclass ]. ^ false! ! !RBSmalllintContext methodsFor: 'initialize-release' stamp: ''! initialize self computeLiterals! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! instVarNames ^self selectedClass allInstVarNames! ! !RBSmalllintContext methodsFor: 'testing' stamp: 'lr 7/23/2010 08:05'! isAbstract: aClass ^(aClass isMeta or: [(self literals includes: aClass name) or: [self literals includes: (Smalltalk globals associationAt: aClass name)]]) not! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! literals literalSemaphore isNil ifTrue: [literals isNil ifTrue: [self computeLiterals. literalSemaphore wait]] ifFalse: [literalSemaphore wait]. ^literals! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! messages messages isNil ifTrue: [self computeMessages]. ^messages! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! parseTree ^parseTree isNil ifTrue: [parseTree := self buildParseTree] ifFalse: [parseTree]! ! !RBSmalllintContext methodsFor: 'private' stamp: 'lr 9/8/2011 20:25'! primitiveComputeLiterals | semaphore | literals := IdentitySet new: 25000. literals addAll: self specialSelectors keys. selectors := IdentitySet new. RBBrowserEnvironment new classesDo: [ :each | self computeLiteralsForClass: each ]. semaphore := literalSemaphore. literalSemaphore := nil. self signalProcesses: semaphore. ^literalProcess := nil! ! !RBSmalllintContext methodsFor: 'printing' stamp: 'lr 3/28/2009 14:39'! printOn: aStream super printOn: aStream. self selectedClass isNil ifFalse: [ aStream nextPut: $ ; nextPutAll: self selectedClass name. self selector isNil ifFalse: [ aStream nextPutAll: '>>'; print: self selector ] ]! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! protocol ^self selectedClass whichCategoryIncludesSelector: self selector! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! protocols ^Array with: self protocol! ! !RBSmalllintContext methodsFor: 'initialize-release' stamp: ''! release literalProcess notNil ifTrue: [literalProcess terminate]. super release! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selectedClass ^class! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selectedClass: anObject class := anObject. self selector: nil! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selector ^selector! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selector: anObject selector := anObject. parseTree := compiledMethod := selfMessages := superMessages := messages := nil! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selectors literalSemaphore isNil ifTrue: [selectors isNil ifTrue: [self computeLiterals. literalSemaphore wait]] ifFalse: [literalSemaphore wait]. ^selectors! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! selfMessages selfMessages isNil ifTrue: [self computeMessages]. ^selfMessages! ! !RBSmalllintContext methodsFor: 'private' stamp: ''! signalProcesses: aSemaphore aSemaphore isNil ifTrue: [^self]. [aSemaphore isEmpty] whileFalse: [aSemaphore signal]! ! !RBSmalllintContext methodsFor: 'accessing' stamp: 'nk 2/26/2005 10:19'! sourceCode ^self selectedClass sourceCodeAt: self selector ifAbsent: [ '' ].! ! !RBSmalllintContext methodsFor: 'private' stamp: 'dvf 9/15/2001 17:39'! specialSelectors | answer | answer := IdentityDictionary new. (Smalltalk specialSelectors select: [:sel | sel isSymbol]) do: [:sel | answer at: sel put: nil.]. ^answer.! ! !RBSmalllintContext methodsFor: 'accessing' stamp: ''! superMessages superMessages isNil ifTrue: [self computeMessages]. ^superMessages! ! !RBSmalllintContext methodsFor: 'testing' stamp: ''! uses: anObject ^self literals includes: anObject! ! RBTransformationRule initialize!