Update the state of a snippet promise when the process is terminated …

…from the debugger [feenkcom/gtoolkit#3942]
feenkcom · Aug 21, 2024 · ba0ad86 · ba0ad86
1 parent 2e4f361
commit ba0ad86
Show file tree

Hide file tree

Showing 6 changed files with 79 additions and 40 deletions.
diff --git a/src/GToolkit-GemStone-Lepiter/GtGemStoneSnippetPromise.class.st b/src/GToolkit-GemStone-Lepiter/GtGemStoneSnippetPromise.class.st
@@ -13,6 +13,17 @@ Class {
 	#category : #'GToolkit-GemStone-Lepiter-Coder'
 }
 
+{ #category : #resolving }
+GtGemStoneSnippetPromise >> break: aReason [ 
+	value := aReason.
+	state := #Broken.
+]
+
+{ #category : #resolving }
+GtGemStoneSnippetPromise >> breakWithEvaluationResult: evaluationResult [ 
+	self break: evaluationResult.
+]
+
 { #category : #testing }
 GtGemStoneSnippetPromise >> canStopExecution [
 	^ executionContext notNil and: [
@@ -45,7 +56,17 @@ GtGemStoneSnippetPromise >> fulfill: anObject [
 	state := #Fulfilled
 ]
 
-{ #category : #private }
+{ #category : #resolving }
+GtGemStoneSnippetPromise >> fulfillWithEvaluationResult: evaluationResult [ 
+	| computedResult |
+	computedResult := evaluationResult computedResult.
+	computedResult := gtRsrEvaluatorPromise 
+		basicDeserializeResult: evaluationResult computedResult.
+
+	self fullfilWithComputedResult: computedResult
+]
+
+{ #category : #resolving }
 GtGemStoneSnippetPromise >> fullfilWithComputedResult: computedResult [ 
 	computedResult associationsDo: [ :binding |
 		(snippetCoderModel pharoBindings bindingOf: binding key asSymbol) 
@@ -76,11 +97,6 @@ GtGemStoneSnippetPromise >> gtRsrEvaluatorPromise: anObject [
 	gtRsrEvaluatorPromise := anObject
 ]
 
-{ #category : #testing }
-GtGemStoneSnippetPromise >> hasResult [
-	^ value ~~ self
-]
-
 { #category : #initialization }
 GtGemStoneSnippetPromise >> initialize [
 	super initialize.
@@ -90,6 +106,20 @@ GtGemStoneSnippetPromise >> initialize [
 	state := #PendingResolution.
 ]
 
+{ #category : #testing }
+GtGemStoneSnippetPromise >> isBroken [
+	"Report if the receiver is currently broken"
+
+	^state == #Broken
+]
+
+{ #category : #testing }
+GtGemStoneSnippetPromise >> isFulfilled [
+	"Report is the receiver is currently fulfilled"
+
+	^state == #Fulfilled
+]
+
 { #category : #testing }
 GtGemStoneSnippetPromise >> isGtEvaluationException [
 
@@ -98,9 +128,16 @@ GtGemStoneSnippetPromise >> isGtEvaluationException [
 
 { #category : #testing }
 GtGemStoneSnippetPromise >> isResolved [
+	"Report if the receiver is currently resolved."
 
-	^ gtRsrEvaluatorPromise isResolved and: [
-		value ~~ self ]
+	^self isFulfilled or: [self isBroken]
+]
+
+{ #category : #resolving }
+GtGemStoneSnippetPromise >> resolveWithEvaluationResult: evaluationResult [ 
+	evaluationResult isEvaluationCancelledResult 
+		ifTrue: [ self breakWithEvaluationResult: evaluationResult ]
+		ifFalse: [ self fulfillWithEvaluationResult: evaluationResult ]
 ]
 
 { #category : #accessing }
@@ -142,7 +179,7 @@ GtGemStoneSnippetPromise >> value [
 
 { #category : #private }
 GtGemStoneSnippetPromise >> wait [
-	| rawEvaluationResultData evaluationResult computedResult |
+	| rawEvaluationResultData evaluationResult |
 
 	executionContext := gtRsrEvaluatorPromise value.
 	rawEvaluationResultData := executionContext wait.
@@ -154,11 +191,7 @@ GtGemStoneSnippetPromise >> wait [
 	evaluationResult hasEvaluationException ifTrue: [ 
 		evaluationResult := evaluationResult signalGemStoneDebugger.
 		self gemStoneSession ifNotNil: [ :aGemStoneSession |
-			evaluationResult gtPharoProxyInitializeWithSession: aGemStoneSession ]. ].
-
-	computedResult := evaluationResult computedResult.
-	computedResult := gtRsrEvaluatorPromise 
-		basicDeserializeResult: evaluationResult computedResult.
+			evaluationResult gtPharoProxyInitializeWithSession: aGemStoneSession ] ].
 
-	self fullfilWithComputedResult: computedResult
+	self resolveWithEvaluationResult: evaluationResult
 ]
diff --git a/src/GToolkit-GemStone-Lepiter/GtGemStoneSnippetPromiseResolution.class.st b/src/GToolkit-GemStone-Lepiter/GtGemStoneSnippetPromiseResolution.class.st
@@ -44,17 +44,13 @@ GtGemStoneSnippetPromiseResolution >> ensureExecuting [
 		state := #Running.
 		startTimestamp := DateAndTime now.
 		[
-			| computedValue |
 			self notifyResolutionStarted.
-
-			computedValue := snippetPromise value.
-			state := computedValue 
-				ifNil: [ #Cancelled ] 
-				ifNotNil: [ #Completed ] .
+			snippetPromise value.
 		] ensure: [
 			endTimestamp := DateAndTime now.
-			(state = #Running) 
-				ifTrue: [ state := #'Terminated' ].
+			(state = #Running) ifTrue: [ 
+				state := #'Terminated'.
+				snippetPromise break: nil ].
 
 			self notifyResolutionCompleted ].
 	] forkNamed: 'GtGemStoneSnippetPromiseExecution resolution process'.

diff --git a/src/GToolkit-GemStone/GtGemstoneEvaluationCancelledResult.class.st b/src/GToolkit-GemStone/GtGemstoneEvaluationCancelledResult.class.st
@@ -0,0 +1,15 @@
+Class {
+	#name : #GtGemstoneEvaluationCancelledResult,
+	#superclass : #GtGemstoneEvaluationResult,
+	#category : #'GToolkit-GemStone'
+}
+
+{ #category : #accessing }
+GtGemstoneEvaluationCancelledResult >> computedResult [
+	^ nil
+]
+
+{ #category : #testing }
+GtGemstoneEvaluationCancelledResult >> isEvaluationCancelledResult [
+	^ true
+]
diff --git a/src/GToolkit-GemStone/GtGemstoneEvaluationInProgressResult.class.st b/src/GToolkit-GemStone/GtGemstoneEvaluationInProgressResult.class.st
@@ -1,33 +1,33 @@
 Class {
-	#name : 'GtGemstoneEvaluationInProgressResult',
-	#superclass : 'GtGemstoneEvaluationResult',
+	#name : #GtGemstoneEvaluationInProgressResult,
+	#superclass : #GtGemstoneEvaluationResult,
 	#instVars : [
 		'evaluationContext'
 	],
 	#category : 'GToolkit-GemStone'
 }
 
-{ #category : 'accessing' }
+{ #category : #accessing }
 GtGemstoneEvaluationInProgressResult >> computedResult [
 	^ self evaluationContext
 ]
 
-{ #category : 'accessing' }
+{ #category : #accessing }
 GtGemstoneEvaluationInProgressResult >> evaluationContext [
 	^ evaluationContext
 ]
 
-{ #category : 'accessing' }
+{ #category : #accessing }
 GtGemstoneEvaluationInProgressResult >> evaluationContext: aGemStoneEvaluationContext [
 	evaluationContext := aGemStoneEvaluationContext
 ]
 
-{ #category : 'initialization ' }
+{ #category : #'initialization ' }
 GtGemstoneEvaluationInProgressResult >> gtPharoProxyInitializeWithSession: aGemStoneSession [
 	evaluationContext gtPharoProxyInitializeWithSession: aGemStoneSession
 ]
 
-{ #category : 'initialization ' }
+{ #category : #'initialization ' }
 GtGemstoneEvaluationInProgressResult >> initializeFromJSONDictionary: aDictionary [
 	super initializeFromJSONDictionary: aDictionary.
 

diff --git a/src/GToolkit-GemStone/GtGemstoneEvaluationResult.class.st b/src/GToolkit-GemStone/GtGemstoneEvaluationResult.class.st
@@ -40,3 +40,8 @@ GtGemstoneEvaluationResult >> hasEvaluationException [
 { #category : #'initialization ' }
 GtGemstoneEvaluationResult >> initializeFromJSONDictionary: aDictionary [
 ]
+
+{ #category : #testing }
+GtGemstoneEvaluationResult >> isEvaluationCancelledResult [
+	^ false
+]
diff --git a/src/GToolkit-GemStone/GtGemstoneEvaluationTerminatedResult.class.st b/src/GToolkit-GemStone/GtGemstoneEvaluationTerminatedResult.class.st