Add newProcessNamed:evaluating:at: to LanguagePlatform (#131)

* Add LanguagePlatform>>#newProcessNamed:evaluating:at: * Add GemStone64Platform>>#newProcessNamed:evaluating:at:
ba-st · Nov 19, 2024 · 89936c7 · 89936c7
1 parent af3ccb2
commit 89936c7
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 5 deletions.
diff --git a/source/Buoy-Metaprogramming-Extensions/LanguagePlatform.class.st b/source/Buoy-Metaprogramming-Extensions/LanguagePlatform.class.st
@@ -63,6 +63,12 @@ LanguagePlatform >> messageDigest: string [
   ^ self subclassResponsibility
 ]
 
+{ #category : 'process scheduling' }
+LanguagePlatform >> newProcessNamed: processName evaluating: block at: priority [
+
+  self subclassResponsibility
+]
+
 { #category : 'accessing' }
 LanguagePlatform >> os [
 	"Returns the underlying operating system abstraction"

diff --git a/source/Buoy-Metaprogramming-GS64-Extensions/GemStone64Platform.class.st b/source/Buoy-Metaprogramming-GS64-Extensions/GemStone64Platform.class.st
@@ -26,16 +26,22 @@ GemStone64Platform >> atInstanceVariableNamed: name on: object put: value [
 GemStone64Platform >> fork: block named: processName at: priority [
 
 	| process |
-	process := block newProcess.
-	process
-		beForked;
-		name: processName;
-		priority: priority.
+	process := self newProcessNamed: processName evaluating: block at: priority.
 	process resume.
 	Processor yield.
 	^process
 ]
 
+{ #category : 'process scheduling' }
+GemStone64Platform >> newProcessNamed: processName evaluating: block at: priority [
+
+  ^ block newProcess
+      beForked;
+      priority: priority;
+      name: processName;
+      yourself
+]
+
 { #category : 'reflection' }
 GemStone64Platform >> globalNamed: aSymbol ifAbsent: absentBlock [
 

diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/PharoPlatform.class.st b/source/Buoy-Metaprogramming-Pharo-Extensions/PharoPlatform.class.st
@@ -42,6 +42,15 @@ PharoPlatform >> messageDigest: string [
   ^ SHA256 hashMessage: string
 ]
 
+{ #category : 'process scheduling' }
+PharoPlatform >> newProcessNamed: processName evaluating: block at: priority [
+
+  ^ block newProcess
+      priority: priority;
+      name: processName;
+      yourself
+]
+
 { #category : 'accessing' }
 PharoPlatform >> os [
 

diff --git a/source/Buoy-Metaprogramming-Tests/LanguagePlatformTest.class.st b/source/Buoy-Metaprogramming-Tests/LanguagePlatformTest.class.st
@@ -101,6 +101,31 @@ LanguagePlatformTest >> testMessageDigest [
          2 208 191 55 201 229 146 ]
 ]
 
+{ #category : 'tests' }
+LanguagePlatformTest >> testNewProcessNamedEvaluatingAt [
+
+  | wasEvaluated semaphore process |
+  wasEvaluated := false.
+  semaphore := Semaphore new.
+
+  process := LanguagePlatform current
+               newProcessNamed: 'Testing LanguagePlatform fork'
+               evaluating: [
+                   wasEvaluated := true.
+                   semaphore signal
+                 ]
+               at: Processor userBackgroundPriority.
+
+  self
+    assert: process name equals: 'Testing LanguagePlatform fork';
+    assert: process priority equals: Processor userBackgroundPriority.
+
+  process resume.
+  semaphore wait.
+
+  self assert: wasEvaluated
+]
+
 { #category : 'tests' }
 LanguagePlatformTest >> testOSEnvironment [