Revert "Revert "New rule: Presenter should not redefine new""

src/BaselineOfSpecCore/BaselineOfSpecCore.class.st

@@ -29,6 +29,9 @@ BaselineOfSpecCore >> baseline: spec [
 			package: 'Spec2-Code' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ];
 			package: 'Spec2-Code-Commands' with: [ spec requires: #('Spec2-Core' 'Spec2-Commands') ];
 			package: 'Spec2-Code-Diff' with: [ spec requires: #('Spec2-Code') ];
+			"Rules"
+			package: 'Spec2-Rules' with: [ spec requires: #('Spec2-Core') ];
+			package: 'Spec2-Rules-Tests' with: [ spec requires: #('Spec2-Tests' 'Spec2-Rules') ];
 			"Common widgets"
 			package: 'Spec2-CommonWidgets' with: [ spec requires: #('Spec2-Core' 'Spec2-Layout') ];
 			package: 'Spec2-CommonWidgets-Tests' with: [ spec requires: #('Spec2-CommonWidgets' 'Spec2-Tests') ];
@@ -58,10 +61,11 @@ BaselineOfSpecCore >> baseline: spec [
 		'Spec2-ListView'  
 		'Spec2-Interactions' 
 		'Spec2-Commander2' ).
+	spec group: 'Rules' with: #('Core' 'Spec2-Rules').
 	spec group: 'Code' with: #('Core' 'Spec2-Code-Commands' 'Spec2-Code' 'Spec2-Code-Diff').
 	spec group: 'CodeTests' with: #('Spec2-Code-Tests' 'Spec2-Code-Diff-Tests').
 	spec group: 'Support' with: #('Core' 'Spec2-Examples').
-	spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests' 'Spec2-ListView-Tests').
+	spec group: 'Tests' with: #('Core' 'Spec2-Tests' 'Spec2-Commander2-Tests' 'Spec2-ListView-Tests' 'Spec2-Rules-Tests').
 	spec group: 'SupportTests' with: #('Support').
 	spec group: 'Pillar' with: #('Spec2-Pillar' ).
 	spec group: 'Base' with: #('Core' 'Support').

src/Spec2-Rules-Tests/RePresenterShouldNotRedefineNewTest.class.st

@@ -0,0 +1,45 @@
+Class {
+	#name : 'RePresenterShouldNotRedefineNewTest',
+	#superclass : 'ReAbstractRuleTestCase',
+	#instVars : [
+		'classFactory'
+	],
+	#category : 'Spec2-Rules-Tests',
+	#package : 'Spec2-Rules-Tests'
+}
+
+{ #category : 'running' }
+RePresenterShouldNotRedefineNewTest >> setUp [
+
+	super setUp.
+	classFactory := ClassFactoryForTestCase new
+]
+
+{ #category : 'running' }
+RePresenterShouldNotRedefineNewTest >> tearDown [
+
+	classFactory cleanUp.
+	super tearDown
+]
+
+{ #category : 'tests' }
+RePresenterShouldNotRedefineNewTest >> testRule [
+
+	| class |
+	class := classFactory make: [ :builder | builder superclass: StPresenter ].
+
+	class compile: 'new ^ 67' classified: 'initialization'.
+
+	self assert: (self myCritiquesOnMethod: class >> #new) size equals: 1
+]
+
+{ #category : 'tests' }
+RePresenterShouldNotRedefineNewTest >> testRuleNotViolated [
+
+	| class |
+	class := classFactory make: [ :builder | builder superclass: StPresenter ].
+
+	class compile: 'method ^ 15' classified: 'initialization'.
+
+	self assertEmpty: (self myCritiquesOnMethod: class >> #method)
+]

src/Spec2-Rules-Tests/ReSpecShouldNotReferenceToolsRuleTest.class.st

@@ -0,0 +1,46 @@
+Class {
+	#name : 'ReSpecShouldNotReferenceToolsRuleTest',
+	#superclass : 'ReAbstractRuleTestCase',
+	#instVars : [
+		'classFactory'
+	],
+	#category : 'Spec2-Rules-Tests',
+	#package : 'Spec2-Rules-Tests'
+}
+
+{ #category : 'running' }
+ReSpecShouldNotReferenceToolsRuleTest >> setUp [
+
+	super setUp.
+	classFactory := ClassFactoryForTestCase new
+]
+
+{ #category : 'running' }
+ReSpecShouldNotReferenceToolsRuleTest >> tearDown [
+
+	classFactory cleanUp.
+	super tearDown
+]
+
+{ #category : 'tests' }
+ReSpecShouldNotReferenceToolsRuleTest >> testRule [
+
+	| class |
+	class := classFactory make: [ :builder |
+		         builder superclass: StPresenter ].
+
+	class
+		compile: 'method ^ Smalltalk tools inspector'
+		classified: 'initialization'.
+
+	self
+		assert: (self myCritiquesOnMethod: class >> #method) size
+		equals: 1
+]
+
+{ #category : 'tests' }
+ReSpecShouldNotReferenceToolsRuleTest >> testRuleNotViolated [
+
+	self generateMethod: 'method ^ Smalltalk tools workspace open '.
+	self assertEmpty: (self myCritiquesOnMethod: self class >> #method)
+]

src/Spec2-Rules-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'Spec2-Rules-Tests' }

src/Spec2-Rules/RePresenterShouldNotRedefineNew.class.st

@@ -0,0 +1,34 @@
+"
+This rule warn the user if `new` method is redefined in a StPresenter subclass. 
+Presenters should not define `new` again since they inherit from StPresenter `new` method.
+"
+Class {
+	#name : 'RePresenterShouldNotRedefineNew',
+	#superclass : 'ReNodeBasedRule',
+	#category : 'Spec2-Rules-Presenter',
+	#package : 'Spec2-Rules',
+	#tag : 'Presenter'
+}
+
+{ #category : 'accessing' }
+RePresenterShouldNotRedefineNew class >> ruleName [ 
+
+	^ 'A presenter should not redefine "new" method'
+
+]
+
+{ #category : 'accessing' }
+RePresenterShouldNotRedefineNew class >> severity [
+
+	^ #warning
+]
+
+{ #category : 'running' }
+RePresenterShouldNotRedefineNew >> basicCheck: aNode [
+
+	| class |
+	aNode isMethod ifFalse: [ ^ false ].
+	aNode methodNode selector = #new ifFalse: [ ^ false ].
+	class := aNode methodClass instanceSide.
+	^ class inheritsFrom: StPresenter 
+]

src/Spec2-Rules/ReSpecShouldNotReferenceToolsRule.class.st

@@ -0,0 +1,46 @@
+"
+This rule warn the user if `Smalltalk tools` is referenced in a Spec subclass. Presenters should access the tools via the application doing `self application tools` instead.
+"
+Class {
+	#name : 'ReSpecShouldNotReferenceToolsRule',
+	#superclass : 'ReNodeBasedRule',
+	#category : 'Spec2-Rules-Presenter',
+	#package : 'Spec2-Rules',
+	#tag : 'Presenter'
+}
+
+{ #category : 'accessing' }
+ReSpecShouldNotReferenceToolsRule class >> ruleName [
+
+	^ 'Spec subclasses should not reference Smalltalk tools'
+]
+
+{ #category : 'accessing' }
+ReSpecShouldNotReferenceToolsRule class >> severity [
+
+	^ #warning
+]
+
+{ #category : 'running' }
+ReSpecShouldNotReferenceToolsRule >> basicCheck: aNode [
+
+	| class |
+	aNode isMessage ifFalse: [ ^ false ].
+	class := aNode methodNode methodClass.
+	class ifNil: [ ^ false ].
+	(class inheritsFrom: StPresenter) ifFalse: [ ^ false ].
+	^ self isToolReference: aNode
+]
+
+{ #category : 'testing' }
+ReSpecShouldNotReferenceToolsRule >> isToolReference: aMessageNode [
+
+	aMessageNode receiver isVariable ifTrue: [
+			Smalltalk tools tools valuesDo: [ :toolClass |
+				toolClass name = aMessageNode receiver name ifTrue: [ ^ true ] ] ].
+
+	(aMessageNode receiver isVariable and: [
+		 aMessageNode receiver name = 'Smalltalk' ]) ifFalse: [ ^ false ].
+
+	^ aMessageNode keywords = #( 'tools' )
+]

src/Spec2-Rules/package.st

@@ -0,0 +1 @@
+Package { #name : 'Spec2-Rules' }