Improved Survey test setup
This commit is contained in:
Patrick Donelan
parent
4d181da7f9
commit
3105b27034
4 changed files with 127 additions and 32 deletions
|
|
@ -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 } );
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
});
|
||||
|
||||
|
|
|
|||
|
|
@ -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 = <<END_SPEC;
|
|||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - jumps to S1
|
||||
ok 2 - jumps to S1Q0
|
||||
ok 1 - Page containing Section S0 Question S0Q0 jumps to S1
|
||||
ok 2 - Page containing Section S0 Question S0Q0 jumps to S1Q0
|
||||
END_TAP
|
||||
|
||||
# deliberately pass in a spec that will fail
|
||||
|
|
@ -156,7 +157,7 @@ $spec = <<END_SPEC;
|
|||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP, fail => 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 = <<END_SPEC;
|
|||
{
|
||||
"test" : {
|
||||
"S1Q0" : "Yes",
|
||||
"next" : "S3", # a goto jumps
|
||||
"next" : "S3", # a goto jump
|
||||
}
|
||||
},
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - jumps to S3
|
||||
ok 1 - Page containing Section S1 Question S1Q0 jumps to S3
|
||||
END_TAP
|
||||
|
||||
# Use tags..
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "Yes",
|
||||
"next" : "S1",
|
||||
"tags" : [ "tagged at S0Q0" ], # and tagged correctly
|
||||
}
|
||||
},
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - Page containing Section S0 Question S0Q0 jumps to S1 and tags data
|
||||
END_TAP
|
||||
|
||||
# Use setup..
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"setup" : { "S0Q0" : "Yes" }, # S0Q0 tags 'tagged at S0Q0'
|
||||
"S1Q0" : "No",
|
||||
"next" : "S2",
|
||||
"tags" : [ "tagged at S0Q0" ], # tagged by setup step
|
||||
}
|
||||
},
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - Page containing Section S1 Question S1Q0 jumps to S2 and tags data
|
||||
END_TAP
|
||||
|
||||
# Use nested setup..
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"setup" : {
|
||||
"setup" : {
|
||||
"S0Q0" : "Yes" # tags 'tagged at S0Q0'
|
||||
},
|
||||
"S1Q0" : "No", # tags 'tagged at S1Q0'
|
||||
},
|
||||
"S2Q0" : null,
|
||||
"next" : "S3",
|
||||
"tags" : [ "tagged at S0Q0", "tagged at S1Q0", ], # tagged by setup step
|
||||
}
|
||||
},
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - Page containing Section S2 Question S2Q0 jumps to S3 and tags data
|
||||
END_TAP
|
||||
|
||||
#########
|
||||
|
|
@ -233,7 +292,7 @@ $spec = <<END_SPEC;
|
|||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0 and tags correct
|
||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
||||
END_TAP
|
||||
|
||||
|
|
@ -253,7 +312,7 @@ $spec = <<END_SPEC;
|
|||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S1Q0 mc answer 1 jumps to S3
|
||||
ok 1 - S1Q0 mc answer 1 jumps to S3 and tags correct
|
||||
ok 2 - S1Q0 mc answer 2 jumps to S2
|
||||
END_TAP
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue