SystemOrganization addCategory: #'Refactoring-Tests-Critics'! Object subclass: #RBSmalllintTestObject instanceVariableNames: 'temporaryVariable' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Tests-Critics'! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! asOrderedCollectionNotNeeded self foo addAll: (1 to: 10) asOrderedCollection! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! assignmentInBlock [^self printString] ensure: [self close]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! assignmentInIfTrue | variable | self isVariable ifTrue: [variable := self] ifFalse: [variable := self printString]. ^variable! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! atIfAbsent ^ Smalltalk at: #MyTest ifAbsent: [| collection | collection := #(). Smalltalk at: #MyTest put: collection]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! badMessage self become: String new! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! booleanPrecedence ^true & 4 = 45! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! collectSelectNotUsed (1 to: 10) select: [:each | each = 4]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! collectionMessagesToExternalObject self someObject collection remove: 10! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! collectionProtocol | newCollection | newCollection := OrderedCollection new. (1 to: 10) asOrderedCollection do: [:each | | new | new := each * 2. newCollection add: new]. ^newCollection! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! consistencyCheck ^(1 to: 10) at: 1! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! contains ^((1 to: 10) detect: [:each | each > 2] ifNone: [nil]) isNil! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! cruft self halt! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! detectContains ^(1 to: 10) do: [:each | each > 2 ifTrue: [^each]]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! endTrueFalse self isVariable ifTrue: [self printString. self isVariable printString] ifFalse: [self printString. ^4]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! equalNotUsed | string | string = '' yourself. (1 to: 10) do: [:i | string := i printString]. ^string! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! equalsTrue ^true == self! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! extraBlock ^[:arg | arg + 43] value: 45! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! fileBlocks | file | ^ [file := 'asdf' asFilename readStream. file contents] ensure: [file close]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! fullBlocks ^[thisContext]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! guardingClause self isSymbol ifFalse: [self printString. self isSymbol printString]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! ifTrueReturns self isSymbol ifFalse: [^true]. ^false! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! isLiteral ^false! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! justSendsSuper super justSendsSuper! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! literalArrayCharacters ^#($a $b $c) includes: $a! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! literalArrayWithTrueFalseOrNil | a b c | a := #(true false nil). b := #(#true #false #nil). c := {true. false. nil}. ^{a. b. c}! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! literalArrayWithTrueFalseOrNil2 | b c | b := #(#true #false #nil). c := #(#true (#true #false #nil) #false #nil). ^b! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! longMethods self printString. self printString. self isVariable ifTrue: [self printString]. self isVariable ifTrue: [self printString]. self isVariable ifTrue: [self printString]. self isVariable ifTrue: [self printString]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! minMax "Bug in 3<5 ifTrue: [3] ifFalse: [5]" ^3<5 ifTrue: [3] ifFalse: [5] " | var | var := 4. var < 5 ifTrue: [var := 5]. ^var"! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! missingYourself ^(OrderedCollection new) add: 1; add: 2; removeFirst! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! modifiesCollection | collection | collection := (1 to: 10) asOrderedCollection. collection do: [:each | each > 5 ifTrue: [collection remove: each]]. ^collection! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! noIsNil: arg ^arg = nil or: [ arg ~= nil ]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! precedence ^self isArray ifFalse: [self block + 5 * 34] ifTrue: [self printString = 10]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:17'! refersToClass ^ RBSmalllintTestObject! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! release self printString! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! returnInEnsure [self error: 'asdf'] ensure: [^4]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! returnsBooleanAndOther self isVariable ifTrue: [^false]. self printString! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! returnsIfTrue ^self isNil ifTrue: [4]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! searchingLiteral ^self printString = #a or: [#() = self printString | ( #() == self printString)]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! sendsDifferentSuper super printString! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! sizeCheck self isEmpty ifFalse: [self do: [:each | Transcript show: each; cr]]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! stringConcatenation | string | string := '' yourself. (1 to: 10) do: [:i | string := string , i printString]. ^string! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! tempVarOverridesInstVar | temporaryVariable | temporaryVariable := 4. ^temporaryVariable! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! tempsReadBeforeWritten | temp | self isVariable ifTrue: [temp := 4]. ^temp! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! threeElementPoint ^5 @ 5 + 6 @ 6! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! toDo 1 to: self size do: [:i | (self at: i) printString]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! toDoCollect | array | array := Array new: 10. 1 to: 10 do: [:i | array at: i put: i * i]. ^array! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! toDoWithIncrement | counter | counter := 0. 1 to: 10 by: 2 do: [:i | counter := counter + 2]. ^counter! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! usesAdd ^(1 to: 10) asOrderedCollection addAll: (11 to: 20)! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! variableAssignedLiteral temporaryVariable := #() ! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! whileTrue | i | i := 1. [i < self size] whileTrue: [(self at: i) printString. i := i + 1]! ! !RBSmalllintTestObject methodsFor: 'methods' stamp: 'lr 9/7/2010 20:12'! yourselfNotUsed self printString; printString; yourself! ! TestCase subclass: #RBSmalllintTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Tests-Critics'! !RBSmalllintTest class methodsFor: 'accessing' stamp: 'lr 9/5/2010 10:48'! packageNamesUnderTest ^ #('Refactoring-Critics')! ! !RBSmalllintTest methodsFor: 'private' stamp: ''! checkRule: aLintRule isEqualTo: anEnvironment | returnedEnvironment | returnedEnvironment := aLintRule result. self compare: returnedEnvironment to: anEnvironment. self compare: anEnvironment to: returnedEnvironment! ! !RBSmalllintTest methodsFor: 'private' stamp: 'lr 9/7/2010 20:19'! compare: subEnvironment to: superEnvironment subEnvironment classesDo: [ :class | (subEnvironment selectorsForClass: class) do: [ :selector | self assert: (superEnvironment includesSelector: selector in: class) ] ]! ! !RBSmalllintTest methodsFor: 'private' stamp: 'lr 12/24/2008 16:50'! currentSelector ^ testSelector! ! !RBSmalllintTest methodsFor: 'private' stamp: 'lr 2/26/2009 16:10'! ruleFor: aSelector self ruleFor: aSelector plusSelectors: #()! ! !RBSmalllintTest methodsFor: 'private' stamp: 'lr 9/7/2010 20:24'! ruleFor: aSelector plusSelectors: symbolCollection | returnedEnvironment rule class selector className | selector := aSelector asString copyFrom: 5 to: aSelector size. className := 'RB' , selector , 'Rule'. class := Smalltalk classNamed: className. class isNil ifTrue: [ self error: className , ' class not found' ]. selector at: 1 put: selector first asLowercase. selector := selector asSymbol. SmalllintChecker runRule: (rule := class new) onEnvironment: self smalllintTestEnvironment. returnedEnvironment := SelectorEnvironment new. returnedEnvironment addClass: RBSmalllintTestObject selector: selector. symbolCollection do: [ :each | returnedEnvironment addClass: RBSmalllintTestObject selector: each ]. self assert: (rule name isString and: [ rule name notEmpty ]) description: 'Missing rule name'. self assert: (rule group isString and: [ rule group notEmpty ]) description: 'Missing group name'. self assert: (rule rationale isString and: [ rule rationale notEmpty ]) description: 'Missing rationale'. self assert: (#(error warning information) includes: rule severity) description: 'Invalid severity'. self checkRule: rule isEqualTo: returnedEnvironment! ! !RBSmalllintTest methodsFor: 'private' stamp: 'lr 9/7/2010 20:14'! smalllintTestEnvironment | classEnvironment | classEnvironment := ClassEnvironment new. classEnvironment addClass: RBSmalllintTestObject. ^ classEnvironment! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'! testAsOrderedCollectionNotNeeded self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'! testAssignmentInBlock self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testAssignmentInIfTrue self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:13'! testAtIfAbsent self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testBadMessage self ruleFor: self currentSelector plusSelectors: #(cruft)! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testBooleanPrecedence self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testCollectSelectNotUsed self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testCollectionMessagesToExternalObject self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testCollectionProtocol self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'! testConsistencyCheck self ruleFor: self currentSelector plusSelectors: #(#noIsNil: )! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testContains self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testDetectContains self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testEndTrueFalse self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testEqualNotUsed self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testEqualsTrue self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 9/7/2010 20:19'! testEquivalentSuperclassMethods | returnedEnvironment rule | SmalllintChecker runRule: (rule := RBEquivalentSuperclassMethodsRule new) onEnvironment: self smalllintTestEnvironment. returnedEnvironment := SelectorEnvironment new. returnedEnvironment addClass: RBSmalllintTestObject selector: #isLiteral. self checkRule: rule isEqualTo: returnedEnvironment! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'! testExtraBlock self ruleFor: self currentSelector plusSelectors: #(#testMethod1 )! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testFileBlocks self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'bh 4/8/2000 19:06'! testFullBlocks "skip this test in squeak" " self blockRuleFor: self currentSelector plusSelectors: #(#caller1 #fullBlocks #detectContains #fileBlocks #moveDefinition #caller #assignmentInBlock #equalNotUsed #stringConcatenation #noMoveDefinition #referencesConditionFor: #returnInEnsure)"! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testGuardingClause self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testIfTrueBlocks self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testIfTrueReturns self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testJustSendsSuper self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testLiteralArrayCharacters self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testLongMethods self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testMinMax self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:15'! testMissingYourself self ruleFor: self currentSelector plusSelectors: #(#inlineMethod )! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testModifiesCollection self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testPrecedence self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testRefersToClass self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testReturnInEnsure self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testReturnsBooleanAndOther self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testReturnsIfTrue self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testSearchingLiteral self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testSendsDifferentSuper self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testSizeCheck self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testStringConcatenation self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testTempVarOverridesInstVar self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:12'! testTempsReadBeforeWritten self ruleFor: self currentSelector plusSelectors: #(#inlineTemporary #noMoveDefinition #tempsReadBeforeWritten #equalNotUsed #fileBlocks #referencesConditionFor:)! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testThreeElementPoint self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testToDo self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testToDoCollect self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testToDoWithIncrement self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testUsesAdd self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testWhileTrue self ruleFor: self currentSelector! ! !RBSmalllintTest methodsFor: 'tests' stamp: 'lr 2/26/2009 16:14'! testYourselfNotUsed self ruleFor: self currentSelector! !