diff options
Diffstat (limited to 'test/src/test-http-debugger.pl')
| -rwxr-xr-x | test/src/test-http-debugger.pl | 208 |
1 files changed, 208 insertions, 0 deletions
diff --git a/test/src/test-http-debugger.pl b/test/src/test-http-debugger.pl new file mode 100755 index 0000000..14b2468 --- /dev/null +++ b/test/src/test-http-debugger.pl @@ -0,0 +1,208 @@ +#!/usr/bin/perl + +use lib './perl'; +use strict; +use File::Spec; +use File::Basename; +use Cwd 'abs_path'; +use JSON qw(from_json to_json); +use LWP; +use HTTP::Request::Common qw(POST GET); +use Data::Dumper; + +my $scxmlBin = abs_path(shift); +die ("First argument needs to be path to uscxml-browser binary") if (!$scxmlBin); +die("'" . $scxmlBin . "' is not an executable file") if (! -x $scxmlBin); + +my $baseDir = File::Spec->canonpath(dirname($0)); +chdir $baseDir; + +my $ua = LWP::UserAgent->new; +my $request; +my $response; +my $data; +my @breakpointSeq; + +my $pid = fork; + +if (!$pid) { + # exec("$scxmlBin -t4088 -d"); + exit; +} + +# my $baseURL = 'http://localhost:4088/debug'; +my $baseURL = 'http://localhost:5080/debug'; + +sub assertSuccess { + my $response = shift; + my $message = shift; + from_json($response->content())->{'status'} eq "success" or die($message); +} + +sub popAndCompare { + my $qualified = shift; + my $bp = shift(@breakpointSeq); + for my $key (keys %{$bp}) { + if (! exists($qualified->{$key}) || $qualified->{$key} ne $bp->{$key}) { + print Dumper($qualified); + print Dumper($bp); + die("Expected different breakpoint"); + } + } + print "SUCCESS\n"; +} + +sub testSimpleStepping { + + my $xml = << 'END_SCXML'; + <scxml> + <state id='s1'> + <onentry> + <log label="'foo'" /> + </onentry> + <transition target='s2' /> + </state> + <state id='s2'> + <transition target='pass' /> + </state> + <final id='pass' /> + </scxml> +END_SCXML + + @breakpointSeq = ( + { subject => "microstep", when => "before" }, + { subject => "state", when => "before", action => "enter" }, + { subject => "state", when => "after", action => "enter" }, + { subject => "state", when => "before", action => "enter", stateId => "s1" }, + { subject => "executable", when => "before", execName => "log" }, + { subject => "executable", when => "after", execName => "log" }, + { subject => "state", when => "after", action => "enter", stateId => "s1" }, + { subject => "microstep", when => "after" }, + { subject => "microstep", when => "before" }, + { subject => "state", when => "before", action => "exit", stateId => "s1" }, + { subject => "state", when => "after", action => "exit", stateId => "s1" }, + { subject => "transition", when => "before", source => "s1", target => "s2"}, + { subject => "transition", when => "after", source => "s1", target => "s2"}, + { subject => "state", when => "before", action => "enter", stateId => "s2" }, + { subject => "state", when => "after", action => "enter", stateId => "s2" }, + { subject => "microstep", when => "after" }, + { subject => "microstep", when => "before" }, + { subject => "state", when => "before", action => "exit", stateId => "s2" }, + { subject => "state", when => "after", action => "exit", stateId => "s2" }, + { subject => "transition", when => "before", source => "s2", target => "pass"}, + { subject => "transition", when => "after", source => "s2", target => "pass"}, + { subject => "state", when => "before", action => "enter", stateId => "pass" }, + { subject => "state", when => "after", action => "enter", stateId => "pass" }, + { subject => "microstep", when => "after" }, + + ); + + ### Get a session + $request = GET $baseURL.'/connect'; + $response = $ua->request($request); + assertSuccess($response, "Could not connect"); + + my $session = from_json($response->content())->{'session'}; + die("Cannot acquire session from server") if (!$session); + + ### Prepare an SCXML interpreter + $request = POST $baseURL.'/prepare', + [ + 'session' => $session, + 'url' => 'http://localhost/test152.scxml', + 'xml' => $xml + ]; + $response = $ua->request($request); + assertSuccess($response, "Could not prepare SCXML"); + + while(@breakpointSeq > 0) { + ### Take a step + $request = POST $baseURL.'/step', ['session' => $session]; + $response = $ua->request($request); + assertSuccess($response, "Could not step"); + # this will cause the interpreter to pause execution + + ### Get the pending messages + $request = POST $baseURL.'/poll', ['session' => $session]; + $response = $ua->request($request); + assertSuccess($response, "Could not get breakpoint after step"); + + # compare to what we expect + $data = from_json($response->content()); + popAndCompare($data->{'qualified'}); + } + + ### last step will finalize the interpreter + $request = POST $baseURL.'/step', ['session' => $session]; + $response = $ua->request($request); + assertSuccess($response, "Could not get breakpoint after step"); + + ### get the pending server push reply + $request = POST $baseURL.'/poll', ['session' => $session]; + $response = $ua->request($request); + assertSuccess($response, "Could not get breakpoint after step"); + + $data = from_json($response->content()); + die("Machine not yet finished") if ($data->{'replyType'} ne "finished"); + +} + +sub testBreakpoint { + my $xml = << 'END_SCXML'; + <scxml> + <state id='s1'> + <onentry> + <log label="'foo'" /> + </onentry> + <transition target='s2' /> + </state> + <state id='s2'> + <transition target='pass' /> + </state> + <final id='pass' /> + </scxml> +END_SCXML + + ### Get a session + $request = GET $baseURL.'/connect'; + $response = $ua->request($request); + assertSuccess($response, "Could not connect"); + + my $session = from_json($response->content())->{'session'}; + die("Cannot acquire session from server") if (!$session); + + ### Prepare an SCXML interpreter + $request = POST $baseURL.'/prepare', + [ + 'session' => $session, + 'url' => 'http://localhost/test154.scxml', + 'xml' => $xml + ]; + $response = $ua->request($request); + assertSuccess($response, "Could not prepare SCXML"); + + ### Skip to breakpoint + $request = POST $baseURL.'/breakpoint/skipto', + [ + 'session' => $session, + 'when' => 'after', + 'action' => 'enter', + 'subject' => 'state', + 'stateId' => 's1' + ]; + $response = $ua->request($request); + assertSuccess($response, "Could not add breakpoint"); + + ### get the pending server push reply + $request = POST $baseURL.'/poll', ['session' => $session]; + $response = $ua->request($request); + assertSuccess($response, "Could not get breakpoint after step"); + + $data = from_json($response->content()); + print Dumper($data); +} + +# &testSimpleStepping(); +&testBreakpoint(); + +kill('TERM', $pid);
\ No newline at end of file |