make class package work across all Pharo versions for generating test…

… classes
SeasideSt · Feb 4, 2024 · 203d08e · 203d08e
1 parent edd9b01
commit 203d08e
Show file tree

Hide file tree

Showing 5 changed files with 24 additions and 23 deletions.
diff --git a/...sitory/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/defineSubClassOf..st b/...sitory/Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/defineSubClassOf..st
@@ -1,20 +1,4 @@
 accessing-code
 defineSubClassOf: aSuperSymbol
 
-	| class |
-	class := SystemVersion current major >= 12
-		         ifTrue: [
-			         factory make: [ :aBuilder |
-				         aBuilder
-					         superclass: (Smalltalk at: aSuperSymbol);
-					         package: self category ] ]
-		         ifFalse: [
-			         factory
-				         newSubclassOf: (Smalltalk at: aSuperSymbol)
-				         instanceVariableNames: ''
-				         classVariableNames: 'classVarsString'
-				         category: self category ].
-	environment
-		addClass: class;
-		addClass: class classSide.
-	^ class
+	^ self defineSubClassOf: aSuperSymbol inPackage: self category
diff --git a/...ase-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/defineSubClassOf.inPackage..st b/...ase-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/defineSubClassOf.inPackage..st
@@ -0,0 +1,20 @@
+accessing-code
+defineSubClassOf: aSuperSymbol inPackage: packageName
+
+	| class |
+	class := SystemVersion current major >= 12
+		         ifTrue: [
+			         factory make: [ :aBuilder |
+				         aBuilder
+					         superclass: (Smalltalk at: aSuperSymbol);
+					         package: packageName ] ]
+		         ifFalse: [
+			         factory
+				         newSubclassOf: (Smalltalk at: aSuperSymbol)
+				         instanceVariableNames: ''
+				         classVariableNames: 'classVarsString'
+				         category: packageName ].
+	environment
+		addClass: class;
+		addClass: class classSide.
+	^ class
diff --git a/...-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testReferencesNotPortableClass.st b/...-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testReferencesNotPortableClass.st
@@ -2,8 +2,7 @@ tests-block
 testReferencesNotPortableClass
 
 	| class |
-	class := self defineSubClassOf: #GRObject.
-	class package: 'SomeCategory' tag: ''.
+	class := self defineSubClassOf: #GRObject inPackage: 'SomeCategory'.
 	self compile: 'invalid ^ Semaphore new' in: class.
 	self compile: 'valid ^ GRObject new' in: class.
 	self 

diff --git a/...-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testSubclassesNotPortableClass.st b/...-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testSubclassesNotPortableClass.st
@@ -2,8 +2,7 @@ tests-block
 testSubclassesNotPortableClass
 
 	| class |
-	class := self defineSubClassOf: #Mutex.
-	class package: 'SomeCategory' tag: ''.
+	class := self defineSubClassOf: #Mutex inPackage: 'SomeCategory'.
 	self 
 		assertRule: GRSubclassesNotPortableClassRule
 		matches: { class }
diff --git a/...Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesNotPortableClass.st b/...Grease-Tests-Pharo-Slime.package/GRReSlimeTest.class/instance/testUsesNotPortableClass.st
@@ -2,8 +2,7 @@ tests-block
 testUsesNotPortableClass
 
 	| class |
-	class := self defineSubClassOf: #GRObject.
-	class package: 'SomeCategory' tag: ''.
+	class := self defineSubClassOf: #GRObject inPackage: 'SomeCategory'.
 	self compile: 'invalid ^ Semaphore new' in: class.
 	self compile: 'valid ^ GRObject new' in: class.
 	self