[feenkcom/gtoolkit#3942] Iniitial changes in support of non-blocking …

…calls from lepiter.
feenkcom · Aug 6, 2024 · b349d44 · b349d44
1 parent ee97460
commit b349d44
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 20 deletions.
diff --git a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st
@@ -76,11 +76,21 @@ GtGemStoneEvaluationContext >> evalServer: object [
 ]
 
 { #category : 'actions - api' }
-GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [
+GtGemStoneEvaluationContext >> evaluateAndWaitBlock: aBlock from: anEvaluationServer [
 	"Evaluate the supplied block.
 	If it completes successfully, answer the result.
 	If an exception is raised, suspend the evaluation process and answer the receiver."
 
+	self evaluateBlock: aBlock from: anEvaluationServer.
+	^ self wait.
+]
+
+{ #category : 'actions - api' }
+GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [
+	"Start evaluation of the supplied block.
+	If it completes successfully, result is the return value of aBlock.
+	If an exception is raised, suspend the evaluation process and set result to the receiver."
+
 	block := aBlock.
 	semaphore := Semaphore new.
 	completed := false.
@@ -101,9 +111,7 @@ GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [
 		priority: Processor activeProcess priority + 1;
 		breakpointLevel: 1;
 		resume.
-	semaphore wait.
-
-	^ result
+	^ self
 ]
 
 { #category : 'accessing' }
@@ -417,6 +425,13 @@ GtGemStoneEvaluationContext >> variableInfoAtFrameLevel: anInteger [
 		displayData ]
 ]
 
+{ #category : 'actions - api' }
+GtGemStoneEvaluationContext >> wait [
+
+	semaphore wait.
+	^ result
+]
+
 { #category : 'private' }
 GtGemStoneEvaluationContext >> waitMS: milliseconds [
 	(Delay forMilliseconds: milliseconds) wait

diff --git a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContextTest.class.st b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContextTest.class.st
@@ -1,15 +1,15 @@
 Class {
-	#name : #GtGemStoneEvaluationContextTest,
-	#superclass : #TestCase,
+	#name : 'GtGemStoneEvaluationContextTest',
+	#superclass : 'TestCase',
 	#category : 'GToolkit-GemStone-GemStone'
 }
 
-{ #category : #tests }
+{ #category : 'tests' }
 GtGemStoneEvaluationContextTest >> testSourceInfoAtFrameLevel [
 	| context allFrames info |
 
 	context := (GtGemStoneEvaluationContext new
-		evaluateBlock: [ AkgDebuggerPlay new initialize evalBlock value ]
+		evaluateAndWaitBlock: [ AkgDebuggerPlay new initialize evalBlock value ]
 		from: GtRsrEvaluatorServiceServer new) object.
 	allFrames := context process gtAllFrames.
 
@@ -22,12 +22,12 @@ GtGemStoneEvaluationContextTest >> testSourceInfoAtFrameLevel [
 	context process terminate.
 ]
 
-{ #category : #tests }
+{ #category : 'tests' }
 GtGemStoneEvaluationContextTest >> testVariableInfoAtFrameLevel [
 	| context variables |
 
 	context := (GtGemStoneEvaluationContext new
-		evaluateBlock: [ AkgDebuggerPlay new initialize evalBlock value ]
+		evaluateAndWaitBlock: [ AkgDebuggerPlay new initialize evalBlock value ]
 		from: GtRsrEvaluatorServiceServer new) object.
 	variables := context variableInfoAtFrameLevel: 10.
 

diff --git a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st
@@ -9,9 +9,7 @@ GtRsrEvaluatorServiceServer >> evaluate: aString for: anObject bindings: aDictio
 	"Evaluate the receiver's script, answering the result.
 	On the server this is a synchronous operation."
 
-	^ (self
-		gtDo: [ self gtEvaluate: aString for: anObject bindings: aDictionary ]
-		gemstoneDo: [ self gsEvaluate: aString for: anObject bindings: aDictionary ])
+	^ (self gsEvaluate: aString for: anObject bindings: aDictionary)
 			asGtRsrProxyObjectForConnection: _connection
 ]
 
@@ -21,9 +19,7 @@ GtRsrEvaluatorServiceServer >> evaluate: aString for: anObject bindings: aDictio
 	On the server this is a synchronous operation."
 	| result |
 
-	result := self
-		gtDo: [ self gtEvaluate: aString for: anObject bindings: aDictionary ]
-		gemstoneDo: [ self gsEvaluate: aString for: anObject bindings: aDictionary ].
+	result := self gsEvaluate: aString for: anObject bindings: aDictionary.
 	^ (Globals at: aSymbol) new serialize: result.
 ]
 
@@ -33,9 +29,7 @@ GtRsrEvaluatorServiceServer >> evaluateReturnProxy: aString for: anObject bindin
 	On the server this is a synchronous operation."
 	| result |
 
-	result := self
-		gtDo: [ self gtEvaluate: aString for: anObject bindings: aDictionary ]
-		gemstoneDo: [ self gsEvaluate: aString for: anObject bindings: aDictionary ].
+	result :=self gsEvaluate: aString for: anObject bindings: aDictionary.
 	result class == GtRsrProxyServiceServer ifTrue: [ ^ result ].
 	^ GtRsrProxyServiceServer object: result.
 ]
@@ -51,6 +45,25 @@ GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDict
 		symbolDictionary at: key put: value asGtGsArgument ].
 	bindings := GsCurrentSession currentSession symbolList, (Array with: symbolDictionary).
 
+	^ GtGemStoneEvaluationContext new
+		evaluateAndWaitBlock: 
+			[ | method |
+			method := aString _compileInContext: receiver symbolList: bindings.
+			method _executeInContext: receiver ]
+		from: self.
+]
+
+{ #category : 'private - GemStone' }
+GtRsrEvaluatorServiceServer >> gsStartEvaluate: aString for: anObject bindings: aDictionary [
+	"Evaluate the receiver's script, answering the result"
+	| receiver symbolDictionary bindings |
+
+	receiver := anObject asGtGsArgument.
+	symbolDictionary := SymbolDictionary new.
+	aDictionary keysAndValuesDo: [ :key :value |
+		symbolDictionary at: key put: value asGtGsArgument ].
+	bindings := GsCurrentSession currentSession symbolList, (Array with: symbolDictionary).
+
 	^ GtGemStoneEvaluationContext new
 		evaluateBlock: 
 			[ | method |

diff --git a/src/GToolkit-GemStone-GemStone/GtRsrProxyServiceServer.class.st b/src/GToolkit-GemStone-GemStone/GtRsrProxyServiceServer.class.st
@@ -25,7 +25,7 @@ GtRsrProxyServiceServer >> basicPerform: aSymbol withArguments: anArray [
 	"Perform the requested operation, catching errors and returning exception information"
 
 	^ GtGemStoneEvaluationContext new
-		evaluateBlock: [ object perform: aSymbol withArguments: anArray asGtGsArgument ]
+		evaluateAndWaitBlock: [ object perform: aSymbol withArguments: anArray asGtGsArgument ]
 		from: self.
 ]