diff --git a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st index 6df6a68b..13446ad5 100644 --- a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st +++ b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st @@ -34,6 +34,11 @@ GtGemStoneEvaluationContext >> assertNotSignalled [ [ self error: 'Process semaphore already signalled' ] ] +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> block [ + ^ block +] + { #category : 'accessing' } GtGemStoneEvaluationContext >> buildMessageText [ @@ -181,9 +186,15 @@ GtGemStoneEvaluationContext >> handlerBlock: anObject [ If the user resumes the process it will then resume from where the exception was originally raised." ^ [ :ex | - result := self asGtEvaluationExceptionContext asGtRsrProxyObjectForConnection: evalServer _connection. + | newExceptionContext | + exception := ex. devMessage := anObject. + + newExceptionContext := self asGtEvaluationExceptionContext. + result := newExceptionContext asGtRsrProxyObjectForConnection: evalServer _connection. + newExceptionContext result: result. + semaphore signal. process suspend. ex resume ] @@ -195,14 +206,13 @@ GtGemStoneEvaluationContext >> initializeFromContext: aGtGemStoneEvaluationConte process := aGtGemStoneEvaluationContext process. serializationStrategy :=aGtGemStoneEvaluationContext serializationStrategy. result := aGtGemStoneEvaluationContext result. - completed := aGtGemStoneEvaluationContext completed. + completed := aGtGemStoneEvaluationContext isCompleted. devMessage :=aGtGemStoneEvaluationContext devMessage. evalServer := aGtGemStoneEvaluationContext evalServer. block :=aGtGemStoneEvaluationContext block. - callStack := aGtGemStoneEvaluationContext callStack. + semaphore :=aGtGemStoneEvaluationContext semaphore. - "We just signal it in the initial context. Normally should not be needed anymore" - "semaphore :=aGtGemStoneEvaluationContext semaphore." + "callStack := aGtGemStoneEvaluationContext callStack." ] { #category : 'testing' } @@ -281,6 +291,16 @@ GtGemStoneEvaluationContext >> restartFrameLevel: anInteger [ ^ #restart ] +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> result [ + ^ result +] + +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> result: aResult [ + result := aResult +] + { #category : 'actions - debug' } GtGemStoneEvaluationContext >> resume [ @@ -290,6 +310,11 @@ GtGemStoneEvaluationContext >> resume [ ^ result ] +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> semaphore [ + ^ semaphore +] + { #category : 'accessing' } GtGemStoneEvaluationContext >> serializationStrategy [ ^serializationStrategy diff --git a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st index a3ecb050..51b1bf42 100644 --- a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st +++ b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st @@ -34,7 +34,7 @@ GtRsrEvaluatorServiceServer >> evaluateReturnProxy: aString for: anObject bindin { #category : 'private - GemStone' } GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDictionary [ - ^ self evaluate: aString for: anObject bindings: aDictionary serializationStrategy: nil + ^ self gsEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: nil ] { #category : 'private - GemStone' } diff --git a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceTest.class.st b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceTest.class.st index 17ae40d8..f4330dad 100644 --- a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceTest.class.st +++ b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceTest.class.st @@ -1,16 +1,16 @@ Class { - #name : #GtRsrEvaluatorServiceTest, - #superclass : #TestCase, + #name : 'GtRsrEvaluatorServiceTest', + #superclass : 'TestCase', #category : 'GToolkit-GemStone-GemStone' } -{ #category : #private } +{ #category : 'private' } GtRsrEvaluatorServiceTest >> gsErrorClass [ ^ CompileError ] -{ #category : #private } +{ #category : 'private' } GtRsrEvaluatorServiceTest >> should: testBlock raise: anErrorClass withExceptionDo: exceptionBlock [ testBlock @@ -21,7 +21,7 @@ GtRsrEvaluatorServiceTest >> should: testBlock raise: anErrorClass withException self error: anErrorClass printString, ' not raised'. ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testCompilationError [ "Confirm that a compilation error is caught and returned in" | script evaluator context | @@ -35,7 +35,7 @@ GtRsrEvaluatorServiceTest >> testCompilationError [ self assert: context exception messageText = 'a CompileError occurred (error 1001), expected a primary expression '. ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testInitialState [ "Check that the initial state answers the expected information" | process exception state encodedState deserializedState contextSpecification | @@ -78,7 +78,7 @@ GtRsrEvaluatorServiceTest >> testInitialState [ self deny: deserializedState isTerminated. ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testProxiedObjectScript [ "Test answering a complex object. Assumes that Associations are not immediate" @@ -109,7 +109,7 @@ anArray.'. ^ result. ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testRuntimeErrorScript [ | script evaluator result object | @@ -119,12 +119,12 @@ GtRsrEvaluatorServiceTest >> testRuntimeErrorScript [ result := evaluator evaluate: script for: 4 bindings: Dictionary new. self assert: result class = GtRsrProxyServiceServer. object := result object. - self assert: object class = GtGemStoneEvaluationContext. + self assert: object class = GtGemStoneEvaluationExceptionContext. "Pharo raises #adaptToNumber:andSend:, GemStone raises #_generality" self assert: (#(#adaptToNumber:andSend: #'_generality') includes: object exception message selector). ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testSelfScript [ | script evaluator result | @@ -134,7 +134,7 @@ GtRsrEvaluatorServiceTest >> testSelfScript [ self assert: result equals: 7. ] -{ #category : #tests } +{ #category : 'tests' } GtRsrEvaluatorServiceTest >> testSimpleScript [ | script evaluator result |