Skip to content

Commit

Permalink
implement GsInteraction tests
Browse files Browse the repository at this point in the history
  • Loading branch information
dalehenrich committed Apr 19, 2016
1 parent a7db426 commit 35b9f55
Show file tree
Hide file tree
Showing 43 changed files with 496 additions and 6 deletions.
@@ -0,0 +1,6 @@
server callbacks
executeRestoreFromBackupFromClient: backupPath
"restoreFromBackup normally terminates the session, so the client will need to
- close all of the windows (including shell window?)
- run the command as a GCI call
- start a new session on success and forward any errors our way"
Expand Up @@ -14,6 +14,7 @@
"evaluate:" : "dkh 4/19/2016 09:20",
"evaluateCommand:" : "dkh 4/19/2016 10:07",
"evaluateFrom:" : "dkh 4/19/2016 06:36",
"executeRestoreFromBackupFromClient:" : "dkh 4/19/2016 11:57",
"getSessionDescription" : "dkh 4/19/2016 05:59",
"loginWith:" : "dkh 4/19/2016 10:07",
"logout" : "dkh 4/19/2016 09:45",
Expand Down
@@ -1 +1 @@
(name 'Tode-Minimal-Client-Core-dkh.6' message '#253 implement services registry (for server callbacks) in minimal client' id 'e0c3c402-a9c1-4d7b-894e-baf1f655ada8' date '19 April 2016' time '11:33:35.066967 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.5' message '#253 tode command line execution is functional' id '22b068ae-b4b9-4cdd-928f-983733b3d00f' date '19 April 2016' time '10:16:53.881356 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.4' message '#253 implementing TDMinimalClient>>evaluate: which takes a tODE command and executes it ...' id '465a0c1c-f91f-49ee-88cf-da95c3eadf1f' date '19 April 2016' time '6:57:42.543698 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.3' message 'minimal tode client login functional!' id '72ddd092-155e-4988-b8c5-4879fed2b963' date '19 April 2016' time '6:00:35.970673 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.2' message '#253 TDMinimalClient>>loginWith: is working up until the clientForwarder send ... which is pretty good' id 'fb43446c-66d5-4e33-8f32-2fe1f61294b7' date '16 April 2016' time '8:14:01.400538 pm' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.1' message '#253 start work on minimal client implementation ... dependent upong GsDevKit/GsDevKit_home#103 as well' id '04a9011f-075f-4a0c-9874-a9e2cf894f58' date '16 April 2016' time '11:40:28.303675 am' author 'dkh' ancestors () stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())
(name 'Tode-Minimal-Client-Core-dkh.7' message 'implement GsInteraction tests' id '137c6d90-c6ee-421c-8deb-1f6fbe42cb98' date '19 April 2016' time '2:49:10.986355 pm' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.6' message '#253 implement services registry (for server callbacks) in minimal client' id 'e0c3c402-a9c1-4d7b-894e-baf1f655ada8' date '19 April 2016' time '11:33:35.066967 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.5' message '#253 tode command line execution is functional' id '22b068ae-b4b9-4cdd-928f-983733b3d00f' date '19 April 2016' time '10:16:53.881356 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.4' message '#253 implementing TDMinimalClient>>evaluate: which takes a tODE command and executes it ...' id '465a0c1c-f91f-49ee-88cf-da95c3eadf1f' date '19 April 2016' time '6:57:42.543698 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.3' message 'minimal tode client login functional!' id '72ddd092-155e-4988-b8c5-4879fed2b963' date '19 April 2016' time '6:00:35.970673 am' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.2' message '#253 TDMinimalClient>>loginWith: is working up until the clientForwarder send ... which is pretty good' id 'fb43446c-66d5-4e33-8f32-2fe1f61294b7' date '16 April 2016' time '8:14:01.400538 pm' author 'dkh' ancestors ((name 'Tode-Minimal-Client-Core-dkh.1' message '#253 start work on minimal client implementation ... dependent upong GsDevKit/GsDevKit_home#103 as well' id '04a9011f-075f-4a0c-9874-a9e2cf894f58' date '16 April 2016' time '11:40:28.303675 am' author 'dkh' ancestors () stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())) stepChildren ())
Empty file.
@@ -0,0 +1,10 @@
accessing
gsClassDefinition
"self gsClassDefinition"

^ 'Object subclass: ''TDMinimalClientInteractionGenerator''
instVarNames: ' , self instVarNames printString
,
'
inDictionary: SymbolDictionary new.
'
@@ -0,0 +1,7 @@
interactions
choiceInteraction: prompt labels: labels values: values lines: lines
^ (GsChoiceInteraction
prompt: prompt
labels: labels
values: values
lines: lines) signal
@@ -0,0 +1,9 @@
interactions
choiceInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self
choiceInteraction: (ar at: 1)
labels: (ar at: 2)
values: (ar at: 3)
lines: (ar at: 4)
@@ -0,0 +1,7 @@
interactions
confirmInteraction: prompt confirm: confirm cancel: cancel abort: abort
^ (GsConfirmInteraction
prompt: prompt
confirm: confirm
cancel: cancel
abort: abort) signal
@@ -0,0 +1,9 @@
interactions
confirmInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self
confirmInteraction: (ar at: 1)
confirm: (ar at: 2)
cancel: (ar at: 3)
abort: (ar at: 4)
@@ -0,0 +1,3 @@
interactions
informInteraction: message
^ (GsInformInteraction message: message) signal
@@ -0,0 +1,5 @@
interactions
informInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self informInteraction: (ar at: 1)
@@ -0,0 +1,3 @@
interactions
inspectInteraction: theObject
^ (GsInspectInteraction theObject: theObject) signal
@@ -0,0 +1,5 @@
interactions
inspectInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self inspectInteraction: (ar at: 1)
@@ -0,0 +1,3 @@
interactions
multiLineTextInteraction: prompt template: template
^ (GsMultiLineTextInteraction prompt: prompt template: template) signal
@@ -0,0 +1,5 @@
interactions
multiLineTextInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self multiLineTextInteraction: (ar at: 1) template: (ar at: 2)
@@ -0,0 +1,7 @@
interactions
notifyInteraction: prompt confirm: confirm cancel: cancel abort: abort
^ (GsNotifyInteraction
prompt: prompt
confirm: confirm
cancel: cancel
abort: abort) signal
@@ -0,0 +1,9 @@
interactions
notifyInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self
notifyInteraction: (ar at: 1)
confirm: (ar at: 2)
cancel: (ar at: 3)
abort: (ar at: 4)
@@ -0,0 +1,3 @@
interactions
textInteraction: prompt template: template
^ (GsTextInteraction prompt: prompt template: template) signal
@@ -0,0 +1,3 @@
interactions
textInteractionRequestPassword: prompt
^ (GsTextInteraction requestPassword: prompt ) signal
@@ -0,0 +1,5 @@
interactions
textInteractionRequestPasswordUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self textInteractionRequestPassword: (ar at: 1)
@@ -0,0 +1,5 @@
interactions
textInteractionUsing: stonString
| ar |
ar := STON fromString: stonString.
^ self textInteraction: (ar at: 1) template: (ar at: 2)
@@ -0,0 +1,20 @@
{
"class" : {
"gsClassDefinition" : "dkh 4/19/2016 13:35" },
"instance" : {
"choiceInteraction:labels:values:lines:" : "dkh 4/19/2016 13:09",
"choiceInteractionUsing:" : "dkh 4/19/2016 13:27",
"confirmInteraction:confirm:cancel:abort:" : "dkh 4/19/2016 13:54",
"confirmInteractionUsing:" : "dkh 4/19/2016 13:53",
"informInteraction:" : "dkh 4/19/2016 14:01",
"informInteractionUsing:" : "dkh 4/19/2016 14:00",
"inspectInteraction:" : "dkh 4/19/2016 14:07",
"inspectInteractionUsing:" : "dkh 4/19/2016 14:06",
"multiLineTextInteraction:template:" : "dkh 4/19/2016 14:46",
"multiLineTextInteractionUsing:" : "dkh 4/19/2016 14:46",
"notifyInteraction:confirm:cancel:abort:" : "dkh 4/19/2016 13:56",
"notifyInteractionUsing:" : "dkh 4/19/2016 13:55",
"textInteraction:template:" : "dkh 4/19/2016 14:38",
"textInteractionRequestPassword:" : "dkh 4/19/2016 14:43",
"textInteractionRequestPasswordUsing:" : "dkh 4/19/2016 14:43",
"textInteractionUsing:" : "dkh 4/19/2016 14:37" } }
@@ -0,0 +1,20 @@
{
"category" : "Tode-Minimal-Client-Tests",
"classinstvars" : [
],
"classvars" : [
"GsChoiceInteraction",
"GsConfirmInteraction",
"GsInformInteraction",
"GsInspectInteraction",
"GsMultiLineTextInteraction",
"GsNotifyInteraction",
"GsTextInteraction" ],
"commentStamp" : "",
"instvars" : [
],
"name" : "TDMinimalClientInteractionGenerator",
"pools" : [
],
"super" : "Object",
"type" : "normal" }
@@ -0,0 +1,3 @@
private
generatorOopType
^ generatorOopType ifNil: [ self installInteractionGenerator ]
@@ -0,0 +1,62 @@
private
installInteractionGenerator
| stream |
(stream := WriteStream on: String new)
nextPutAll: '| class |';
cr;
nextPutAll: 'class := ' , TDMinimalClientInteractionGenerator gsClassDefinition;
cr;
nextPutAll: 'UserGlobals at: #TD_MINIMAL_CLIENT_INTERACTION_GENERATOR_CLASS put: class.';
cr;
yourself.
self client session executeString: stream contents.
TDMinimalClientInteractionGenerator
selectorsDo: [ :each |
| source result |
stream := WriteStream on: String new.
source := TDMinimalClientInteractionGenerator sourceCodeAt: each.
stream
nextPutAll: '| source result symbolList |';
cr;
nextPutAll: 'symbolList := System myUserProfile symbolList.';
cr;
nextPutAll: 'source := '.
source string printOn: stream.
stream
nextPutAll: '.';
cr;
nextPutAll: '[result := TD_MINIMAL_CLIENT_INTERACTION_GENERATOR_CLASS';
cr;
tab;
nextPutAll: 'compileMethod: source';
cr;
tab;
nextPutAll: 'dictionaries: symbolList';
cr;
tab;
nextPutAll: 'category: ''category''] on: Warning do: [:ex | ex resume ].';
cr;
nextPutAll: 'result ~~ nil ifTrue: [ ^GsMethod _sourceWithErrors: result fromString: source ].';
cr;
yourself.
result := self client session executeString: stream contents.
result ~~ nil
ifTrue: [ result
halt: 'Compile error for TDMinimalClientInteractionGenerator>>' , each printString ] ].
stream := WriteStream on: String new.
stream
nextPutAll: '| server |';
cr;
nextPutAll: 'server := TD_MINIMAL_CLIENT_INTERACTION_GENERATOR_CLASS new.';
cr;
nextPutAll: 'System _sessionStateAt: 3 put: server.';
cr;
nextPutAll: 'UserGlobals removeKey: #TD_MINIMAL_CLIENT_INTERACTION_GENERATOR_CLASS.';
cr;
nextPutAll: 'server.';
cr;
yourself.
generatorOopType := self client session executeString: stream contents.
generatorOopType isNil
ifTrue: [ stream contents halt ].
^ generatorOopType
@@ -0,0 +1,33 @@
tests
testChoiceInteraction
| choice prompt labels values lines generatorStonString expectedChoice |
prompt := 'Select something'.
labels := {'label1' . 'label2'}.
values := {1 . 2}.
lines := {1}.
self client
registerService: [ :stonString :aClient |
| interaction response |
interaction := aClient objectSerializer fromString: stonString.
self
assert: interaction prompt = prompt;
assert: interaction labels = labels;
assert: interaction values = values;
assert: interaction lines = lines.
response := false
ifTrue: [ interaction interact ]
ifFalse: [ expectedChoice ].
aClient objectSerializer toString: response ]
for: #interactWith:.
generatorStonString := STON
toString:
{prompt.
labels.
values.
lines}.
expectedChoice := 1.
choice := self client session
send: #choiceInteractionUsing:
to: self generatorOopType
withArgs: {generatorStonString}.
self assert: choice = expectedChoice
@@ -0,0 +1,32 @@
tests
testConfirmInteraction
| prompt confirm cancel abort generatorStonString answer |
prompt := 'Confirm something'.
confirm := 'confirm'.
cancel := 'cancel'.
abort := 'abort'.
self client
registerService: [ :stonString :aClient |
| interaction response |
interaction := aClient objectSerializer fromString: stonString.
self
assert: interaction prompt = prompt;
assert: interaction confirm = confirm;
assert: interaction cancel = cancel;
assert: interaction abort = abort.
response := false
ifTrue: [ interaction interact ]
ifFalse: [ true ].
aClient objectSerializer toString: response ]
for: #interactWith:.
generatorStonString := STON
toString:
{prompt.
confirm.
cancel.
abort}.
answer := self client session
send: #confirmInteractionUsing:
to: self generatorOopType
withArgs: {generatorStonString}.
self assert: answer
@@ -0,0 +1,7 @@
tests
testDbContinue_
| cmdResult |
self client
registerService: [ :processOop :aClient | self halt ]
for: #dbContinue:.
cmdResult := self client evaluate: ''
@@ -0,0 +1,7 @@
tests
testDbStep_forProcessOop_
| cmdResult |
self client
registerService: [ :level :processOop :aClient | self halt ]
for: #dbStep:forProcessOop:.
cmdResult := self client evaluate: ''
@@ -1,5 +1,5 @@
tests
testEditCommand
testEditStonElement_
| cmdResult |
self client
registerService: [ :stonString :aClient |
Expand Down
@@ -0,0 +1,6 @@
tests
testExecuteRestoreFromBackupFromClient_
| cmdResult |
true
ifTrue: [ ^ self ]. "don't accidentally restore from backup"
cmdResult := self client evaluate: 'bu restore testBackup.dbf'
@@ -0,0 +1,20 @@
tests
testInformInteraction
| message generatorStonString answer |
message := 'Inform something'.
self client
registerService: [ :stonString :aClient |
| interaction response |
interaction := aClient objectSerializer fromString: stonString.
self assert: interaction message = message.
response := false
ifTrue: [ interaction interact ]
ifFalse: [ nil ].
aClient objectSerializer toString: response ]
for: #interactWith:.
generatorStonString := STON toString: {message}.
answer := self client session
send: #informInteractionUsing:
to: self generatorOopType
withArgs: {generatorStonString}.
self assert: answer isNil

0 comments on commit 35b9f55

Please sign in to comment.