From 3105b27034f38b653a2f630be1c168b74ce46a90 Mon Sep 17 00:00:00 2001 From: Patrick Donelan Date: Sat, 16 May 2009 09:06:00 +0000 Subject: [PATCH] Improved Survey test setup --- lib/WebGUI/Asset/Wobject/Survey.pm | 1 - .../Asset/Wobject/Survey/ExpressionEngine.pm | 2 +- lib/WebGUI/Asset/Wobject/Survey/Test.pm | 79 ++++++++++++++----- t/Asset/Wobject/Survey/Test.t | 77 +++++++++++++++--- 4 files changed, 127 insertions(+), 32 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 6a974af77..1d7b8f687 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -2654,7 +2654,6 @@ sub www_runTest { my $tap = $result->{tap} or return $self->www_editTestSuite('Unable to determine test result'); - $self->session->log->debug("Got tap: [$tap]"); use TAP::Parser; my $parser = TAP::Parser->new( { tap => $tap } ); diff --git a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm index ca56456b0..c947e2a94 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm @@ -456,7 +456,7 @@ sub run { $compartment->share_from( 'List::Util', [ '&first', '&max', '&maxstr', '&min', '&minstr', '&reduce', '&shuffle', '&sum', ] ); - $session->log->debug("Expression is: \"$expression\""); +# $session->log->debug("Expression is: \"$expression\""); $compartment->reval($expression); diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 87c77310d..ca506134b 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -216,51 +216,84 @@ sub _test { my $testCount = ++${$opts{testCount_ref}}; # ..and the test-specific arguments - my $next = $args->{next}; + my ($next, $tags, $setup ) = @{$args}{qw(next tags setup)}; delete $args->{next}; - # n.b. everything left in %args assumed to be var => answer text + delete $args->{tags}; + delete $args->{setup}; + # n.b. everything left in %args assumed to be variable => answer_spec - # get starting page + my $fakeTestCount = 0; + if ($setup) { + # Recursively call ourselves (ignoring the returned TAP), so that rJSON gets + # updated with responses, simulating the setup spec happening in the past + $self->_test( { + responseJSON => $rJSON, + surveyOrder => $surveyOrder, + surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, + testCount_ref => \$fakeTestCount, + args => $setup, + } ); + } # Record responses my $responses = {}; my $lowestIndex; - my $what = "jumps to $next"; - while ( my ( $variable, $answerText ) = each %$args ) { + while ( my ( $variable, $spec ) = each %$args ) { my $index = $surveyOrderIndexByVariableName->{$variable}; my $address = $surveyOrder->[$index]; - my $answerAddress; + my $question = $rJSON->survey->question($address); + my $questionType = $question->{questionType}; # Keep track of lowest index (to work out what survey page we should test on) $lowestIndex = $index if (!defined $lowestIndex || $index < $lowestIndex); - my $question = $rJSON->survey->question($address); - my $answer; - my $aIndex = 0; - for my $a (@{$question->{answers}}) { - if ($a->{text} =~ m/\Q$answerText\E/i) { - $answerAddress = "$address->[0]-$address->[1]-$aIndex"; - $answer = $a; + # Goal now is to figure out what answer(s) we are supposed to record + if (!defined $spec) { + $self->session->log->debug("Spec undefined, assuming that means ignore answer value"); + } + elsif ( $questionType eq 'Text' || $questionType eq 'Number' ) { + # Assume spec is raw value to record in the single answer + $responses->{"$address->[0]-$address->[1]-0"} = $spec; + } + else { + # Assume spec is the raw text of the answer we want + my $answer; + my $aIndex = 0; + my $answerAddress; + # Iterate over all answers to find the matching + for my $a (@{$question->{answers}}) { + if ($a->{text} =~ m/\Q$spec\E/i) { + $answerAddress = "$address->[0]-$address->[1]-$aIndex"; + $answer = $a; + last; + } + $aIndex++; } - $aIndex++; + if (!$answer) { + return fail($testCount, "determine answer for $variable", "No answers matched text: '$spec'"); + } + $self->session->log->debug("Recording $variable ($answerAddress) => $answer->{recordedAnswer}"); + $responses->{$answerAddress} = $answer->{recordedAnswer}; } - if (!$answer || $answerAddress !~ m/\d+-\d+-\d+/) { - return fail($testCount, $what, 'answerText $answerText does not match any answers in your survey'); - } - my $recordedAnswer = $answer->{recordedAnswer}; - $responses->{$answerAddress} = $recordedAnswer; - $self->session->log->debug("Recording $variable ($answerAddress) => $recordedAnswer"); } $rJSON->nextResponse($lowestIndex); + my $pageSection = $rJSON->survey->section($surveyOrder->[$lowestIndex]); + my $pageQuestion = $rJSON->survey->question($surveyOrder->[$lowestIndex]); + my $what = "Page containing Section $pageSection->{variable}"; + $what .= " Question $pageQuestion->{variable}" if $pageQuestion; + $what .= " jumps to $next" if $next; + $what .= " and tags data" if $tags; + return $self->_recordResponses( { responseJSON => $rJSON, responses => $responses, surveyOrder => $surveyOrder, surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, next => $next, + tags => $tags, testCount => $testCount, what => $what, }); @@ -327,6 +360,10 @@ sub _test_mc { my $recordedAnswer = $answer->{recordedAnswer}; $responses->{$answerAddress} = $recordedAnswer; + my $what = "$variable mc answer " . ($aIndex + 1); + $what .= " jumps to $next" if $next; + $what .= " and tags correct" if $tags; + $self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer"); push @tap, $self->_recordResponses( { responseJSON => $rJSON, @@ -335,7 +372,7 @@ sub _test_mc { surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, next => $next, testCount => $testCount, - what => "$variable mc answer " . ($aIndex + 1) . " jumps to $next", + what => $what, tags => $tags, }); diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 94b0306c8..1ee76e264 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -21,7 +21,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 25; +plan tests => 34; my ( $s, $t1 ); @@ -77,7 +77,8 @@ $s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes $s->surveyJSON_update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tags data $s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No -$s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3' } ); # S1Q0 jumps to S3 +$s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3' } ); # S1Q0 answer 0 jumps to S3 +$s->surveyJSON_update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0'); } } );# S1Q0 answer 1 tags data # And finally, persist the changes.. $s->persistSurveyJSON; @@ -139,8 +140,8 @@ $spec = < < < 1 } ); 1..1 -not ok 1 - jumps to S2 +not ok 1 - Page containing Section S0 Question S0Q0 jumps to S2 # Compared next section/question # got : 'S1' (<-- a section) and 'S1Q0' (<-- a question) # expect : 'S2' @@ -168,14 +169,72 @@ $spec = < < < < < < <