'From Squeak3.4gamma of ''7 January 2003'' [latest update: #5169] on 22 February 2003 at 1:52:22 am'! Smalltalk renameClassNamed: #BPPBlockLintRule as: #GMSEBlockLintRule! BlockLintRule subclass: #GMSEBlockLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions'! Smalltalk renameClassNamed: #ClassesMultipleSelectionModel as: #GMSEClassesMultipleSelectionModel! MultipleSelectionModel variableSubclass: #GMSEClassesMultipleSelectionModel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions'! Smalltalk renameClassNamed: #BPPParseTreeLintRule as: #GMSEParseTreeLintRule! ParseTreeLintRule subclass: #GMSEParseTreeLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions'! Smalltalk renameClassNamed: #CodeFormatterTestCase as: #GMSETestCase! TestCase subclass: #GMSETestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions-Tests'! Smalltalk renameClassNamed: #LintTester as: #GMSETesting! Object subclass: #GMSETesting instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions-Tests'! LintDialog variableSubclass: #GMSELintDialog instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'GMSLintExtensions'! !GMSEBlockLintRule class methodsFor: 'miscellaneous' stamp: 'gm 2/22/2003 01:44'! checkTypeSuggestingParameterName | detector | detector _ self new. detector name: '"Type Suggesting Parameter Name" pattern'. detector methodBlock: [:context :result | | code args shouldAdd | shouldAdd _ false. code _ (context selectedClass sourceCodeAt: context selector) string. args _ context parseTree arguments collect: [:each | each formattedCode]. args do: [:each | each isGoodParameterName ifFalse: [shouldAdd _ true]]. shouldAdd ifTrue: [result addClass: context selectedClass selector: context selector]]. ^ detector! ]style[(32 3 9 4 8 3 4 7 8 7 42 3 8 17 17 8 4 1 4 1 9 7 9 3 5 5 4 4 7 29 7 22 4 3 7 37 6 2 4 20 4 10 6 2 4 37 9 3 4 7 9 14 6 11 7 25 7 16 8)f1b,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i! ! !GMSEBlockLintRule class methodsFor: 'intention revealing' stamp: 'gm 2/22/2003 01:49'! checkMethodNonCommented | detector | detector := self new. detector name: 'Uncommented method'. detector methodBlock: [:context :result | context parseTree comments isEmpty ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !GMSEClassesMultipleSelectionModel methodsFor: '*Refactory-RBAddons' stamp: 'gm 2/14/2003 00:47'! menu: aMenuMorph ^(super menu: aMenuMorph) add: 'Select All Subclasses' action: #selectAllSubclasses; yourself! ! !GMSEClassesMultipleSelectionModel methodsFor: '*Refactory-RBAddons' stamp: 'gm 2/14/2003 00:29'! selectAllSubclasses self selectedItems do: [:each | self selectAllSubclassesOf: each]. self changed: #allSelections! ! !GMSEClassesMultipleSelectionModel methodsFor: '*Refactory-RBAddons' stamp: 'gm 2/14/2003 00:22'! selectAllSubclassesOf: aClassNameSymbol | allSubclasses | allSubclasses _ (Smalltalk classNamed: aClassNameSymbol) allSubclasses. list do: [:each | (allSubclasses includes: (Smalltalk classNamed: each)) ifTrue: [self selectClass: each]]! ! !GMSEClassesMultipleSelectionModel methodsFor: '*Refactory-RBAddons' stamp: 'gm 2/14/2003 00:25'! selectClass: aClassNameSymbol self listSelectionAt: (list indexOf:aClassNameSymbol) put: true ! ! !GMSEParseTreeLintRule class methodsFor: 'morph cleaning project' stamp: 'gm 2/13/2003 21:35'! checkExtensionNilValidation ^ self createParseTreeRule: #('extension == nil' 'extension = nil' 'extension ~= nil' 'extension isNil' 'extension isNotNil') name: 'Checks extension against nil instead of using hasExtension'! ! !GMSEParseTreeLintRule class methodsFor: 'morph cleaning project' stamp: 'gm 2/16/2003 09:22'! checkOwnerNilValidation ^ self createParseTreeRule: #('owner == nil' 'owner = nil' 'owner ~= nil' 'owner isNil' 'owner isNotNil' ) name: 'Checks owner against nil instead of using hasOwner'! ! !GMSEParseTreeLintRule class methodsFor: 'morph cleaning project' stamp: 'gm 2/16/2003 09:21'! checkPlayerNilValidation ^ self createParseTreeRule: #('player == nil' 'player = nil' 'player ~= nil' 'player isNil' 'player isNotNil' ) name: 'Checks player against nil instead of using hasPlayer'! ! !GMSEParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'gm 2/22/2003 01:15'! checkIsKindOfInsteadOfIs | detector matcher className selector | detector _ self new. detector name: 'Uses isKindOf: Foo instead of isFoo'. matcher _ ParseTreeSearcher new. matcher matches: '`@object isKindOf: `@class' do: [:aNode :answer | className _ aNode arguments first formattedCode. selector _ ('is' , className) asSymbol. (Smalltalk allImplementorsOf: selector) notEmpty ifTrue: [aNode] ifFalse: [answer]]. detector matcher: matcher. ^ detector! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/14/2003 00:48'! rule: ruleSelectorSymbol fromClass: aClass approves: testNameSelectorSymbol | context checker | checker := aClass perform: ruleSelectorSymbol. context := SmalllintContext newNoCache. context selectedClass: GMSETesting. checker resetResult. context selector: testNameSelectorSymbol. checker checkMethod: context. ^checker result isEmpty! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/14/2003 00:49'! rule: ruleSelectorSymbol fromClass: aClass disapproves: testNameSelectorSymbol ^(self rule: ruleSelectorSymbol fromClass: aClass approves: testNameSelectorSymbol) not! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/22/2003 01:18'! testIsKindOfInsteadOfIsOK self assert: (self rule: #checkIsKindOfInsteadOfIs fromClass: GMSEParseTreeLintRule approves: #isKindOfInsteadOfIsOK)! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/22/2003 01:18'! testIsKindOfInsteadOfIsWrong self assert: (self rule: #checkIsKindOfInsteadOfIs fromClass: GMSEParseTreeLintRule disapproves: #isKindOfInsteadOfIsWrong)! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/22/2003 01:50'! testMethodNonCommentedOK self assert: (self rule: #checkMethodNonCommented fromClass: GMSEBlockLintRule approves: #methodNonCommentedOK)! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/22/2003 01:51'! testMethodNonCommentedWrong self assert: (self rule: #checkMethodNonCommented fromClass: GMSEBlockLintRule disapproves: #methodNonCommentedWrong)! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/2/2003 01:13'! testStringIsGoodParameterName self shouldnt: '' isGoodParameterName. self shouldnt: '12345' isGoodParameterName. self shouldnt: 'anobject' isGoodParameterName. self shouldnt: 'AnObject' isGoodParameterName. self shouldnt: 'ANOBJECT' isGoodParameterName. self shouldnt: 'aThing' isGoodParameterName. self should: 'anObject' isGoodParameterName. self should: 'anOrderedCollection' isGoodParameterName. self should: 'aClassDescription' isGoodParameterName.! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/16/2003 09:26'! testStringIsLowercase self should: '' isLowercase. self should: 'lower' isLowercase. self shouldnt: 'UPPER' isLowercase. self shouldnt: 'properCase' isLowercase. self should: '123' isLowercase! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 1/26/2003 15:41'! testStringParseWords self should: ('' parseWords = OrderedCollection new). self should: ('lower' parseWords = (OrderedCollection with: 'lower')). self should: ('UPPER' parseWords = (OrderedCollection with: 'U' with: 'P' with: 'P' with: 'E' with: 'R')). self should: ('properCase' parseWords = (OrderedCollection with: 'proper' with: 'Case')). self should: ('MixedCASE' parseWords = (OrderedCollection with: 'Mixed' with: 'C' with: 'A' with: 'S' with: 'E')). self should: ('MiXedCaSe' parseWords = (OrderedCollection with: 'Mi' with: 'Xed' with: 'Ca' with: 'Se')). ! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/13/2003 18:16'! testTypeSuggestingParameterNameOK self assert: (self rule: #checkTypeSuggestingParameterName fromClass: GMSEBlockLintRule approves: #typeSuggestingParameterNameOKWith:and:)! ! !GMSETestCase methodsFor: 'Testing' stamp: 'gm 2/13/2003 18:16'! testTypeSuggestingParameterNameWrong self assert: (self rule: #checkTypeSuggestingParameterName fromClass: GMSEBlockLintRule disapproves: #typeSuggestingParameterNameWrongWith:and:)! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/22/2003 01:16'! isKindOfInsteadOfIsOK ^ self isString! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/22/2003 01:16'! isKindOfInsteadOfIsWrong ^ self isKindOf: String! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/22/2003 01:50'! methodNonCommentedOK "this method is commented" ^self! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/22/2003 01:51'! methodNonCommentedWrong ^'this method is uncommented'! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/4/2003 23:41'! typeSuggestingParameterNameOKWith: anObject and: aClassDescription ^ self! ! !GMSETesting methodsFor: 'testing' stamp: 'gm 2/4/2003 23:27'! typeSuggestingParameterNameWrongWith: something and: somethingElse ^ self! ! !LintDialog methodsFor: 'accessing' stamp: 'gm 2/4/2003 21:58'! testsFromCategory: aCategory ^ (self testsFromCategory: aCategory inClassAndSubclasses: BlockLintRule) , (self testsFromCategory: aCategory inClassAndSubclasses: ParseTreeLintRule)! ! !LintDialog methodsFor: 'accessing' stamp: 'gm 2/4/2003 21:59'! testsFromCategory: aSymbol inClassAndSubclasses: aClass | classAndSubclassesTests | classAndSubclassesTests _ (self testsFromCategory: aSymbol inClass: aClass) asOrderedCollection. aClass allSubclasses do: [:each | classAndSubclassesTests addAll: (self testsFromCategory: aSymbol inClass: each)]. ^ classAndSubclassesTests! ]style[(19 7 23 6 4 24 4 23 4 4 20 7 10 27 3 6 22 6 2 23 14 4 20 7 10 4 7 23)f1b,f1cblue;b,f1b,f1cblue;b,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cred;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:34'! defaultClassCategoriesModel ^ MultipleSelectionModel withList: SystemOrganization categories.! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:36'! defaultClassesModel ^ MultipleSelectionModel withList: #() withMessage: #classesFromCategories! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:35'! defaultTestsCategoriesModel ^ MultipleSelectionModel withList: self determineTestCategories! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:33'! defaultTestsModel ^MultipleSelectionModel withList: #() withMessage: #testsFromCategories. ! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/5/2003 12:43'! determineTestCategories | taskCategories | taskCategories _ (self determineTestCategoriesForClass:BlockLintRule), (self determineTestCategoriesForClass:ParseTreeLintRule). taskCategories removeAllFoundIn: #(#'instance creation' #private ). ^taskCategories asArray! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/13/2003 18:28'! determineTestCategoriesForClass: aClass ^ aClass withAllSubclasses inject: Set new into: [:sum :each | sum addAll: each class organization categories; yourself]! ]style[(33 6 5 6 29 3 14 11 2 3 9 4 46)f1b,f1cblue;b,f1,f1cblue;b,f1,f1cmagenta;,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1! ! !LintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:36'! initialize tests _ self defaultTestsModel. self addDependent: tests. classCategories _ self defaultClassCategoriesModel. classCategories addDependent: self. testCategories _ self defaultTestsCategoriesModel. testCategories addDependent: self. classes _ self defaultClassesModel. self addDependent: classes! ! !LintDialog methodsFor: 'displaying' stamp: 'gm 2/5/2003 12:45'! lintWindow ^(SystemWindow labelled: 'SmallLint') color: Color paleGreen; addMorph: (self listMorphFor: testCategories) frame: (0.0 @ 0.0 extent: 0.33 @ 0.25); addMorph: (self listMorphFor: tests) frame: (0.0 @ 0.25 extent: 0.33 @ 0.59); addMorph: (self listMorphFor: classCategories) frame: (0.33 @ 0.0 extent: 0.33 @ 0.84); addMorph: (self listMorphFor: classes) frame: (0.66 @ 0.0 extent: 0.34 @ 0.84); addMorph: self runButton frame: (0.0 @ 0.84 extent: 0.2 @ 0.16)! ! !GMSELintDialog methodsFor: 'initialize-release' stamp: 'gm 2/14/2003 00:37'! defaultClassesModel ^ GMSEClassesMultipleSelectionModel withList: #() withMessage: #classesFromCategories! ! !String methodsFor: 'accessing' stamp: 'gm 2/14/2003 00:41'! parseWords | word words keyStart keyStop uppercaseLetters | uppercaseLetters _ Character alphabet asUppercase. words _ OrderedCollection new. keyStop _ 1. [keyStop <= self size] whileTrue: [keyStart _ keyStop + 1. word _ self copyFrom: keyStop to: keyStart - 1. keyStop _ self findDelimiters: uppercaseLetters startingAt: keyStart. words add: word , (self copyFrom: keyStart to: keyStop - 1)]. ^ words! ! !String methodsFor: 'testing' stamp: 'gm 2/16/2003 09:26'! isGoodParameterName "whether the receiver is a good parameter name according to Best Practice Patterns" | words probableClassName | self isLowercase ifTrue: [^false]. self first isUppercase ifTrue: [^false]. words := self parseWords. words size < 2 ifTrue: [^false]. probableClassName := ''. words reversed do: [:each | probableClassName := each , probableClassName. (Smalltalk classNamed: probableClassName) notNil ifTrue: [^true]]. ^false! ! !String methodsFor: 'testing' stamp: 'gm 2/16/2003 09:26'! isLowercase "whether the receiver has no Uppercase letters" ^self = self asLowercase! ! !GMSEParseTreeLintRule class reorganize! ('morph cleaning project' checkExtensionNilValidation checkOwnerNilValidation checkPlayerNilValidation) ('miscellaneous' checkIsKindOfInsteadOfIs) ! !GMSEBlockLintRule class reorganize! ('miscellaneous' checkTypeSuggestingParameterName) ('intention revealing' checkMethodNonCommented) !