Ported Slime rule for referencing/using a non-portable class

Johan Brichau · Johan Brichau · commit 2800c455039f · 2024-01-07T17:15:27.000+01:00
diff --git a/repository/BaselineOfGrease.package/BaselineOfGrease.class/instance/baselineCommon..st b/repository/BaselineOfGrease.package/BaselineOfGrease.class/instance/baselineCommon..st
@@ -1,5 +1,6 @@
 baselines
 baselineCommon: spec
+
 	spec
 		for: #common
 		do: [ spec blessing: #baseline.
diff --git a/repository/BaselineOfGrease.package/BaselineOfGrease.class/instance/baselineGemStone..st b/repository/BaselineOfGrease.package/BaselineOfGrease.class/instance/baselineGemStone..st
@@ -1,5 +1,6 @@
 baselines
 baselineGemStone: spec
+
   spec
     for: #'gemstone'
     do: [ 
diff --git a/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/README.md b/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/README.md
diff --git a/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/class/checksMethod.st b/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/class/checksMethod.st
@@ -0,0 +1,4 @@
+testing - interest
+checksMethod
+
+	^ true
diff --git a/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/instance/basicCheck..st b/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/instance/basicCheck..st
@@ -0,0 +1,8 @@
+running
+basicCheck: aMethod
+
+	(aMethod methodClass instanceSide category indexOfSubCollection: #'-Pharo-' startingAt: 1) ~= 0 ifTrue: [ 
+		"classes in a -Pharo- package are per definition not portable and therefore allowed to use non-portable classes" 
+		^ false ].
+
+	^ aMethod literals anySatisfy: [ :each | each isVariableBinding and: [ self classNames includes: each key ] ]
diff --git a/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/instance/name.st b/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/instance/name.st
@@ -0,0 +1,4 @@
+accessing
+name
+
+	^ 'Uses not portable class'
diff --git a/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/properties.json b/repository/Grease-Pharo110-Slime.package/GRReferencesNotPortableClassRule.class/properties.json
@@ -0,0 +1,11 @@
+{
+	"commentStamp" : "",
+	"super" : "GRUsesNotPortableClassRule",
+	"category" : "Grease-Pharo110-Slime",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "GRReferencesNotPortableClassRule",
+	"type" : "normal"
+}
diff --git a/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/README.md b/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/README.md
diff --git a/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/class/checksClass.st b/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/class/checksClass.st
@@ -0,0 +1,4 @@
+testing - interest
+checksClass
+
+	^ true
diff --git a/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/instance/basicCheck..st b/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/instance/basicCheck..st
@@ -0,0 +1,4 @@
+running
+basicCheck: aClass
+
+	^ aClass allSuperclasses anySatisfy: [ :each | self classNames includes: each name ]
diff --git a/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/instance/name.st b/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/instance/name.st
@@ -0,0 +1,4 @@
+accessing
+name
+
+	^ 'Subclasses not portable class'
diff --git a/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/properties.json b/repository/Grease-Pharo110-Slime.package/GRSubclassesNotPortableClassRule.class/properties.json
@@ -0,0 +1,11 @@
+{
+	"commentStamp" : "",
+	"super" : "GRUsesNotPortableClassRule",
+	"category" : "Grease-Pharo110-Slime",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "GRSubclassesNotPortableClassRule",
+	"type" : "normal"
+}
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/README.md b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/README.md
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/class/isAbstract.st b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/class/isAbstract.st
@@ -0,0 +1,4 @@
+testing
+isAbstract 
+
+	^ self == GRUsesNotPortableClassRule
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/classNames.st b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/classNames.st
@@ -0,0 +1,4 @@
+private
+classNames
+
+	^ #( Delay MIMEDocument Monitor Mutex MutexSet Random Semaphore TimeStamp Timestamp MessageSend )
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/group.st b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/group.st
@@ -0,0 +1,4 @@
+accessing
+group
+
+	^ 'Grease Portability'
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/rationale.st b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/instance/rationale.st
@@ -0,0 +1,4 @@
+accessing
+rationale
+
+	^ 'Some classes are not portable accross different Smalltalk dialects.'
diff --git a/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/properties.json b/repository/Grease-Pharo110-Slime.package/GRUsesNotPortableClassRule.class/properties.json
@@ -0,0 +1,11 @@
+{
+	"commentStamp" : "",
+	"super" : "GRReSlimeBlockLintRule",
+	"category" : "Grease-Pharo110-Slime",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "GRUsesNotPortableClassRule",
+	"type" : "normal"
+}
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/canParse..st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/canParse..st
@@ -1,5 +1,6 @@
 accessing-code
 canParse: aString
+
 	RBParser
 		parseMethod: aString
 		onError: [ :err :pos | ^ false ].
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/category.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/category.st
@@ -1,3 +1,4 @@
-accessing
+accessing-code
 category
+
 	^ self class category , '-Data'
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/rules.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/rules.st
@@ -1,8 +1,10 @@
-accessing
+accessing-code
 rules
-	^ OrderedCollection new
+
+	^ (OrderedCollection new
 		addAll: GRReSlimeBlockLintRule allSubclasses;
 		addAll: GRReSlimeParseTreeLintRule allSubclasses;
 "		addAll: GRSlimeTransformationRule allSubclasses;"
 		add: ReMultiplePeriodsTerminatingStatementRule;
-		yourself
+		add: ReUnnecessaryLastPeriodRule;
+		yourself) reject: #isAbstract
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/runCase.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/runCase.st
@@ -1,3 +1,4 @@
 running
 runCase
+
 	GRPlatform current doSilently: [ super runCase ]
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/setUp.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/setUp.st
@@ -1,5 +1,6 @@
 running
 setUp
+
 	super setUp.
 	factory := ClassFactoryForTestCase new.
 	model := RBNamespace new.
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testNonPortableSourceFormat.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testNonPortableSourceFormat.st
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testReferencesNotPortableClass.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testReferencesNotPortableClass.st
@@ -0,0 +1,11 @@
+tests-block
+testReferencesNotPortableClass
+
+	| class |
+	class := self defineSubClassOf: #GRObject.
+	class category: 'SomeCategory'.
+	self compile: 'invalid ^ Semaphore new' in: class.
+	self compile: 'valid ^ GRObject new' in: class.
+	self 
+		assertRule: GRReferencesNotPortableClassRule
+		matches: { class>>#invalid }.
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testSubclassesNotPortableClass.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testSubclassesNotPortableClass.st
@@ -0,0 +1,9 @@
+tests-block
+testSubclassesNotPortableClass
+
+	| class |
+	class := self defineSubClassOf: #Mutex.
+	class category: 'SomeCategory'.
+	self 
+		assertRule: GRSubclassesNotPortableClassRule
+		matches: { class }
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUnnecessaryLastPeriodRule.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUnnecessaryLastPeriodRule.st
@@ -1,10 +1,10 @@
 tests-block
 testUnnecessaryLastPeriodRule
-	<expectedFailure>
+
 	| class |
 	class := self defineSubClassOf: #GRObject.
 	self compile: 'invalid 1. 2.' in: class.
 	self compile: 'valid 1. 2' in: class.
 	self 
-		runRule: GRUnnecessaryLastPeriodRule
-		selectors: #(invalid)
+		assertRule: ReUnnecessaryLastPeriodRule
+		matches: { class>>#invalid }
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesMethodAnnotations.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesMethodAnnotations.st
diff --git a/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesNotPortableClass.st b/repository/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesNotPortableClass.st
@@ -1,10 +1,11 @@
 tests-block
 testUsesNotPortableClass
-	<expectedFailure>
+
 	| class |
 	class := self defineSubClassOf: #GRObject.
+	class category: 'SomeCategory'.
 	self compile: 'invalid ^ Semaphore new' in: class.
 	self compile: 'valid ^ GRObject new' in: class.
 	self 
-		runRule: GRUsesNotPortableClassRule
-		selectors: #(invalid)
+		assertRule: GRReferencesNotPortableClassRule
+		matches: { class>>#invalid }.

-Original file line number
+Diff line change
@@ @@ -0,0 +1,4 @@ @@
 +testing - interest
 +checksMethod
++
 +	^ true