Merge pull request #86 from moosetechnology/rules-renraku

Migrates rules to Renraku

src/Fame-Rules/FameNameConventionBetweenFM3AndSmalltalkRule.class.st

@@ -5,10 +5,16 @@ A FM3 class should be named PACKAGE.CLASSNAME whereas the smalltalk class associ
 "
 Class {
 	#name : #FameNameConventionBetweenFM3AndSmalltalkRule,
-	#superclass : #RBBlockLintRule,
+	#superclass : #ReAbstractRule,
 	#category : #'Fame-Rules'
 }
 
+{ #category : #testing }
+FameNameConventionBetweenFM3AndSmalltalkRule class >> checksClass [
+
+	^ true
+]
+
 { #category : #accessing }
 FameNameConventionBetweenFM3AndSmalltalkRule class >> group [
 	^ 'Fame'
@@ -25,58 +31,20 @@ FameNameConventionBetweenFM3AndSmalltalkRule class >> uniqueIdentifierName [
 	^ 'NameConventionBetweenFM3AndSmalltalk'
 ]
 
-{ #category : #private }
-FameNameConventionBetweenFM3AndSmalltalkRule >> addClass: aClass toMetaBuilderCollection: aCollectionOfClasses [
-	| classToAdd |
-	"we add the class itself"
-	aCollectionOfClasses addIfNotPresent: aClass.
-
-	"We add all classes described in properties pargmas :"
-	aClass methodDict
-		valuesDo: [ :each | 
-			each pragmas
-				detect: [ :p | #(#FMProperty:type:opposite: #FMProperty:type:) includes: p selector ]
-				ifFound: [ :pragma | 
-					classToAdd := (pragma argumentAt: 2) asString.
-					(#('String' 'Number' 'Boolean' 'Object') includes: classToAdd)
-						ifFalse: [ classToAdd = 'FM3.Property'
-								ifTrue: [ (aCollectionOfClasses includes: FM3Property) ifFalse: [ self addClass: FM3Property toMetaBuilderCollection: aCollectionOfClasses ] ]
-								ifFalse: [ classToAdd := Smalltalk classNamed: classToAdd.
-									(aCollectionOfClasses includes: classToAdd) ifFalse: [ self addClass: classToAdd toMetaBuilderCollection: aCollectionOfClasses ] ] ] ] ].
-	"we add the superclass and all classes linked to it: "
-	aClass classSide
-		compiledMethodAt: #annotation
-		ifPresent: [ :compiledMethod | 
-			(compiledMethod pragmaAt: #FMClass:super:)
-				ifNotNil: [ :pragma | 
-					| argument |
-					argument := pragma argumentAt: 2.
-					argument = #Object
-						ifFalse: [ classToAdd := (argument includes: $.)
-								ifTrue: [ classToAdd := ''.
-									(argument substrings: #($.)) do: [ :each | classToAdd := classToAdd , each ].
-									Smalltalk classNamed: classToAdd ]
-								ifFalse: [ Smalltalk classNamed: argument asString ].
-
-							(aCollectionOfClasses includes: classToAdd) ifFalse: [ self addClass: classToAdd toMetaBuilderCollection: aCollectionOfClasses ] ] ] ]
-]
-
 { #category : #running }
-FameNameConventionBetweenFM3AndSmalltalkRule >> checkClass: aContext [
-	| class pragmas pragma metaName |
-	class := aContext.
-	pragmas := Pragma allNamed: #FMClass:super: in: class.
-	pragmas ifEmpty: [ ^ self ].
-	pragmas size > 1
-		ifTrue: [ result addClass: class.
-			^ self ].
-
-	pragma := pragmas first.
-	metaName := pragma argumentAt: 1.
-	(pragma method pragmaAt: #package:)
-		ifNotNil: [ :packagePragma | 
-			| packageName |
-			packageName := packagePragma argumentAt: 1.
-			(packageName , metaName) = class instanceSide name ifFalse: [ result addClass: class selector: pragma selector ] ]
-		ifNil: [ "this happens if the package: pragma is missing" result addClass: class selector: pragma selector ]
+FameNameConventionBetweenFM3AndSmalltalkRule >> basicCheck: aClass [
+
+	| class |
+	class := aClass isClassSide
+		         ifTrue: [ aClass ]
+		         ifFalse: [ aClass class ].
+	^ (Pragma allNamed: #FMClass:super: in: class) ifEmpty: [ ^ false ] ifNotEmpty: [ :pragmas |
+		  pragmas size > 1 ifTrue: [ ^ true ].
+
+		  (pragmas first method pragmaAt: #package:)
+			  ifNotNil: [ :packagePragma |
+				  | metaName |
+				  metaName := pragmas first argumentAt: 1.
+				  (packagePragma argumentAt: 1) , metaName ~= aClass instanceSide name ]
+			  ifNil: [ "this happens if the package: pragma is missing" true ] ]
 ]

src/Fame-Rules/FameOppositeAttributeShouldPointBackRule.class.st

@@ -3,10 +3,16 @@ Check if an opposite attribute declared in a pragma #MSEProperty:type:opposite:
 "
 Class {
 	#name : #FameOppositeAttributeShouldPointBackRule,
-	#superclass : #RBBlockLintRule,
+	#superclass : #ReAbstractRule,
 	#category : #'Fame-Rules'
 }
 
+{ #category : #testing }
+FameOppositeAttributeShouldPointBackRule class >> checksMethod [
+
+	^ true
+]
+
 { #category : #accessing }
 FameOppositeAttributeShouldPointBackRule class >> group [
 	^ 'Fame'
@@ -24,26 +30,21 @@ FameOppositeAttributeShouldPointBackRule class >> uniqueIdentifierName [
 ]
 
 { #category : #running }
-FameOppositeAttributeShouldPointBackRule >> checkMethod: aContext [
+FameOppositeAttributeShouldPointBackRule >> basicCheck: aMethod [
+
 	| class |
-	class := aContext methodClass.
-	((class methodNamed: aContext selector) pragmaAt: #FMProperty:type:opposite:)
-		ifNotNil: [ :pragma | 
-			self class environment
-				at: (pragma argumentAt: 2)
-				ifPresent: [ :oppositeClass | 
-					oppositeClass
-						compiledMethodAt: (pragma argumentAt: 3)
-						ifPresent: [ :oppositeCompiledMethod | 
-							(oppositeCompiledMethod pragmaAt: #FMProperty:type:opposite:)
-								ifNotNil: [ :oppositePragma | 
-									(oppositePragma argumentAt: 2) = class name asSymbol
-										ifFalse: [ result addClass: class selector: aContext selector.
-											^ self ].
-									(oppositePragma argumentAt: 3) = aContext selector
-										ifFalse: [ result addClass: class selector: aContext selector.
-											^ self ] ]
-								ifNil: [ result addClass: class selector: aContext selector.
-									^ self ] ]
-						ifAbsent: [ result addClass: class selector: aContext selector ] ] ]
+	class := aMethod methodClass.
+	((class methodNamed: aMethod selector) pragmaAt: #FMProperty:type:opposite:) ifNotNil: [ :pragma |
+		self class environment at: (pragma argumentAt: 2) ifPresent: [ :oppositeClass |
+			oppositeClass
+				compiledMethodAt: (pragma argumentAt: 3)
+				ifPresent: [ :oppositeCompiledMethod |
+					(oppositeCompiledMethod pragmaAt: #FMProperty:type:opposite:)
+						ifNotNil: [ :oppositePragma |
+							(oppositePragma argumentAt: 2) = class name asSymbol ifFalse: [ ^ true ].
+							(oppositePragma argumentAt: 3) = aMethod selector ifFalse: [ ^ true ] ]
+						ifNil: [ ^ true ] ]
+				ifAbsent: [ ^ true ] ] ].
+
+	^ false
 ]

src/Fame-Rules/FameOppositeClassNotExistRule.class.st

@@ -3,10 +3,16 @@ Check if the opposite class declared in a pragma #MSEProperty:type:opposite: is
 "
 Class {
 	#name : #FameOppositeClassNotExistRule,
-	#superclass : #RBBlockLintRule,
+	#superclass : #ReAbstractRule,
 	#category : #'Fame-Rules'
 }
 
+{ #category : #testing }
+FameOppositeClassNotExistRule class >> checksMethod [
+
+	^ true
+]
+
 { #category : #accessing }
 FameOppositeClassNotExistRule class >> group [
 	^ 'Fame'
@@ -24,9 +30,9 @@ FameOppositeClassNotExistRule class >> uniqueIdentifierName [
 ]
 
 { #category : #running }
-FameOppositeClassNotExistRule >> checkMethod: aContext [
-	| class |
-	class := aContext methodClass.
-	((class methodNamed: aContext selector) pragmaAt: #FMProperty:type:opposite:)
-		ifNotNil: [ :pragma | self class environment at: (pragma argumentAt: 2) ifPresent: [ :oppositeClass | result addClass: class selector: aContext selector ] ]
+FameOppositeClassNotExistRule >> basicCheck: aMethod [
+
+	((aMethod methodClass methodNamed: aMethod selector) pragmaAt: #FMProperty:type:opposite:) ifNotNil: [ :pragma |
+		self class environment at: (pragma argumentAt: 2) ifPresent: [ :oppositeClass | ^ true ] ].
+	^ false
 ]

src/Fame-Rules/FameSuperclassMetaDescribedExistRule.class.st

@@ -3,10 +3,16 @@ Check if a superclass defined in a FM3MetaDescription (generated by a class anot
 "
 Class {
 	#name : #FameSuperclassMetaDescribedExistRule,
-	#superclass : #RBBlockLintRule,
+	#superclass : #ReAbstractRule,
 	#category : #'Fame-Rules'
 }
 
+{ #category : #testing }
+FameSuperclassMetaDescribedExistRule class >> checksClass [
+
+	^ true
+]
+
 { #category : #accessing }
 FameSuperclassMetaDescribedExistRule class >> group [
 	^ 'Fame'
@@ -24,20 +30,23 @@ FameSuperclassMetaDescribedExistRule class >> uniqueIdentifierName [
 ]
 
 { #category : #running }
-FameSuperclassMetaDescribedExistRule >> checkClass: aContext [
-	| class pragmas pragma substrings metaSuperclassName |
-	class := aContext.
-	pragmas := Pragma allNamed: #FMClass:super: in: class.
-	pragmas ifEmpty: [ ^ self ].
-	pragmas size > 1
-		ifTrue: [ result addClass: class.
-			^ self ].
-
-	pragma := pragmas first.
-	metaSuperclassName := pragma argumentAt: 2.
-	substrings := metaSuperclassName asString substrings: #($.).
-
-	substrings size > 1
-		ifTrue: [ Smalltalk at: (substrings first , substrings second) asSymbol ifAbsent: [ result addClass: class classSide selector: #annotation ] ]
-		ifFalse: [ Smalltalk at: substrings first asSymbol ifAbsent: [ result addClass: class classSide selector: #annotation ] ]
+FameSuperclassMetaDescribedExistRule >> basicCheck: aClass [
+
+	| class |
+	class := aClass isClassSide
+		         ifTrue: [ aClass ]
+		         ifFalse: [ aClass class ].
+
+	(Pragma allNamed: #FMClass:super: in: class) ifNotEmpty: [ :pragmas |
+		| pragma substrings metaSuperclassName |
+		pragmas size > 1 ifTrue: [ ^ true ].
+
+		pragma := pragmas first.
+		metaSuperclassName := pragma argumentAt: 2.
+		substrings := metaSuperclassName asString substrings: #( $. ).
+
+		substrings size > 1
+			ifTrue: [ Smalltalk at: (substrings first , substrings second) asSymbol ifAbsent: [ ^ true ] ]
+			ifFalse: [ Smalltalk at: substrings first asSymbol ifAbsent: [ ^ true ] ] ].
+	^ false
 ]