Add an example executing remote code using scripter [feenkcom/gtoolki…

…t#3942]
feenkcom · Aug 26, 2024 · 536ce26 · 536ce26
1 parent 3a59b6e
commit 536ce26
Show file tree

Hide file tree

Showing 3 changed files with 146 additions and 8 deletions.
diff --git a/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemStonePlaygroundExamples.class.st b/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemStonePlaygroundExamples.class.st
@@ -2,7 +2,8 @@ Class {
 	#name : #GtRemoteGemStonePlaygroundExamples,
 	#superclass : #Object,
 	#instVars : [
-		'theExternalSnippetContext'
+		'theExternalSnippetContext',
+		'server'
 	],
 	#category : #'GToolkit-RemoteExamples-GemStone'
 }
@@ -95,6 +96,27 @@ GtRemoteGemStonePlaygroundExamples >> pageToolWithSnippetWithTest1Session [
 	^ pageTool
 ]
 
+{ #category : #examples }
+GtRemoteGemStonePlaygroundExamples >> pageToolWithSnippetWithTestDefaultSessionAndBasicCode [
+	<gtExample>
+	| page pageTool snippet |
+
+	page := LePage new
+		addSnippet: (snippet := LeGemStoneSnippet new
+			code: '1+1';
+			sessionName: 'test:default');
+		yourself.
+
+	self assert: snippet sessionName equals: 'test:default'.
+	self assert: snippet code equals: '1+1'.
+
+	pageTool := LePagePhlowTool new
+		page: page.
+	pageTool externalSnippetContext: self externalSnippetContext.
+
+	^ pageTool
+]
+
 { #category : #examples }
 GtRemoteGemStonePlaygroundExamples >> pageWithEmptySnippetWithNoSession [
 	<gtExample>
@@ -109,6 +131,56 @@ GtRemoteGemStonePlaygroundExamples >> pageWithEmptySnippetWithNoSession [
 	^ page
 ]
 
+{ #category : #examples }
+GtRemoteGemStonePlaygroundExamples >> playgroundPageWithConnectedGemStone [
+	"Example with a GemStone snippet with a session name,
+	and a registry with no session and a configured connector."
+	<gtExample>
+	| pageTool scripter |
+
+	self runningServer.
+
+	self assert: self gemstoneSessionRegistry hasConnectors.
+	self assert: self gemstoneSessionRegistry hasSessions.
+
+	pageTool := self pageToolWithSnippetWithTestDefaultSessionAndBasicCode.
+
+	scripter := self scripterForPageTool: pageTool.
+
+	self 
+		assertGemStoneSessionLabel: 'test' 
+		for: scripter.
+
+	self assert: self gemstoneSessionRegistry sessions size equals: 1.
+	self assert: self gemstoneSessionRegistry sessions values first isRunning.
+	self 
+		assert: self gemstoneSessionRegistry sessions values first name
+		equals: 'test:default'.
+
+	^ scripter
+]
+
+{ #category : #examples }
+GtRemoteGemStonePlaygroundExamples >> playgroundPageWithConnectedGemStone_runAsyncComputation [
+	"Example with a GemStone snippet with a session name,
+	and a registry with no session and a configured connector."
+	<gtExample>
+	| scripter |
+
+	scripter := self playgroundPageWithConnectedGemStone.
+
+	self withEnabledAutomaticReplaceDo: [
+		scripter click
+			label: 'Click on play and inspect button';
+			// GtSourceCoderDoItAndGoActionId;
+			play ].
+
+	scripter pager
+		assertPageCountIs: 2.
+
+	^ scripter
+]
+
 { #category : #examples }
 GtRemoteGemStonePlaygroundExamples >> playgroundWithSnippetWithNoSessionNameOnEmptyRegistry [
 	"Example with a GemStone snippet without a session name,
@@ -200,6 +272,29 @@ GtRemoteGemStonePlaygroundExamples >> playgroundWithSnippetWithSessionNameOnRegi
 	^ scripter
 ]
 
+{ #category : #'examples - setup/tear down' }
+GtRemoteGemStonePlaygroundExamples >> runningServer [
+	"Answer a running server.
+	This assumes:
+	- The GemStone server is running with Gt loaded
+	- Default usernames and passwords
+	- The library is available in {imageDirectory}/remote-gemstone/3.7.0"
+	<gtExample>
+	<after: #stopServer>
+	| connector |
+
+	server ifNotNil: [ ^ server ].
+
+	connector := GtRemoteGemstoneExamplesSessionBuilder createConnectorNamed: 'test'.
+	self gemstoneSessionRegistry  
+		connectorNamed: 'test'
+		ifPresent: [ :aConnector | Error signal: 'Connector already present'] 
+		ifAbsent: [ self gemstoneSessionRegistry connectors
+			at: 'test' put: connector ].
+	^ server := self gemstoneSessionRegistry
+		newSessionOrDefaultWithConnector: connector
+]
+
 { #category : #accessing }
 GtRemoteGemStonePlaygroundExamples >> scripter [
 	^ BlScripter new
@@ -210,7 +305,36 @@ GtRemoteGemStonePlaygroundExamples >> scripterForPageTool: aPageTool [
 	| scripter |
 	scripter := self scripter.
 	scripter
-		model: aPageTool page;
-		element: aPageTool asElement.
+		model: aPageTool;
+		element: (GtPager createWrappedOn: aPageTool asElement).
 	^ scripter
 ]
+
+{ #category : #'examples - setup/tear down' }
+GtRemoteGemStonePlaygroundExamples >> stopServer [ 
+
+	server ifNotNil: 
+		[ server stop.
+		server := nil ].
+]
+
+{ #category : #utils }
+GtRemoteGemStonePlaygroundExamples >> withAutomaticReplaceSetTo: aBoolean do: aBlock [
+	| currentValue |
+	currentValue := GtGemStoneAsyncEvaluationPhlowTool replacePaneContentAutomatically.
+
+	GtGemStoneAsyncEvaluationPhlowTool replacePaneContentAutomatically: aBoolean.
+	aBlock ensure: [
+		GtGemStoneAsyncEvaluationPhlowTool replacePaneContentAutomatically: currentValue ]. 
+
+]
+
+{ #category : #utils }
+GtRemoteGemStonePlaygroundExamples >> withDisabledAutomaticReplaceDo: aBlock [
+	self withAutomaticReplaceSetTo: false do: aBlock
+]
+
+{ #category : #utils }
+GtRemoteGemStonePlaygroundExamples >> withEnabledAutomaticReplaceDo: aBlock [
+	self withAutomaticReplaceSetTo: true do: aBlock
+]
diff --git a/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemStoneSessionAsyncExamples.class.st b/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemStoneSessionAsyncExamples.class.st
@@ -29,7 +29,7 @@ GtRemoteGemStoneSessionAsyncExamples >> stopServer [
 		server := nil ].
 ]
 
-{ #category : #examples }
+{ #category : #'examples - basic' }
 GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_interruptAndCancelComputation [
 	<gtExample>
 	| evaluatorPromise executionContext interruptResultData rawEvaluationResultData errorEvaluationResultData  errorEvaluationResult evaluationResult  terminateEvaluationResultData |
@@ -68,7 +68,7 @@ GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_interruptA
 	^ evaluationResult
 ]
 
-{ #category : #examples }
+{ #category : #'examples - basic' }
 GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_interruptAndResumeComputation [
 	<gtExample>
 	| evaluatorPromise executionContext interruptResultData rawEvaluationResultData resumeEvaluationResult errorEvaluationResultData  errorEvaluationResult evaluationResult  resumedEvaluationResultData |
@@ -112,7 +112,7 @@ GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_interruptA
 	^ evaluationResult
 ]
 
-{ #category : #examples }
+{ #category : #'examples - basic' }
 GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_returnLegacy [
 	<gtExample>
 	| evaluatorPromise executionContext rawEvaluationResultData  evaluationResult |
@@ -143,7 +143,7 @@ GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_returnLega
 	^ evaluationResult
 ]
 
-{ #category : #examples }
+{ #category : #'examples - basic' }
 GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_returnProxy [
 	<gtExample>
 	| evaluatorPromise executionContext rawEvaluationResultData  evaluationResult |
@@ -181,7 +181,7 @@ GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_returnProx
 	^ evaluationResult
 ]
 
-{ #category : #examples }
+{ #category : #'examples - basic' }
 GtRemoteGemStoneSessionAsyncExamples >> testManualResolutionAsyncCall_terminateComputation [
 	<gtExample>
 	| evaluatorPromise executionContext terminatedResultData rawEvaluationResultData  evaluationResult |

diff --git a/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemstoneExamplesSessionBuilder.class.st b/src/GToolkit-RemoteExamples-GemStone/GtRemoteGemstoneExamplesSessionBuilder.class.st
@@ -9,6 +9,12 @@ GtRemoteGemstoneExamplesSessionBuilder class >> createAndStartSession [
 	^ self new createAndStartSession
 ]
 
+{ #category : #accessing }
+GtRemoteGemstoneExamplesSessionBuilder class >> createAndStartSessionForConnector: aConnector [
+	^ self new 
+		createAndStartSessionForConnector: aConnector
+]
+
 { #category : #accessing }
 GtRemoteGemstoneExamplesSessionBuilder class >> createConnectorNamed: aConnectorName [
 	^ self new 
@@ -22,6 +28,14 @@ GtRemoteGemstoneExamplesSessionBuilder >> createAndStartSession [
 		yourself
 ]
 
+{ #category : #accessing }
+GtRemoteGemstoneExamplesSessionBuilder >> createAndStartSessionForConnector: aConnector [
+	^ (GtGemStoneSession new 
+		connector: aConnector) 
+			connect;
+			yourself
+]
+
 { #category : #accessing }
 GtRemoteGemstoneExamplesSessionBuilder >> createConnector [
 	^ self createConnectorNamed: nil