Some minor Survey bug fixes
Removed evil "use JSON -support_by_pp" test() and test_mc() now intelligently start at the right place and give better TAP descriptions
This commit is contained in:
Patrick Donelan
parent
2bde3dc02c
commit
7e0796cc78
2 changed files with 149 additions and 71 deletions
|
|
@ -4,7 +4,7 @@ use strict;
|
|||
use base qw/WebGUI::Crud/;
|
||||
use WebGUI::International;
|
||||
use Test::Deep::NoTest;
|
||||
use JSON -support_by_pp; # so that we can still use allow_barekey etc..
|
||||
use JSON;
|
||||
use Params::Validate qw(:all);
|
||||
Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
|
||||
|
||||
|
|
@ -108,7 +108,7 @@ sub run {
|
|||
or return { tap => "Bail Out! Test spec undefined" };
|
||||
|
||||
eval {
|
||||
$spec = from_json($spec, { relaxed => 1, allow_barekey => 1, allow_singlequote => 1, } );
|
||||
$spec = from_json($spec, { relaxed => 1 } );
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
|
|
@ -224,11 +224,17 @@ sub _test {
|
|||
|
||||
# Record responses
|
||||
my $responses = {};
|
||||
my $lowestIndex;
|
||||
|
||||
my $what = "jumps to $next";
|
||||
while ( my ( $variable, $answerText ) = each %$args ) {
|
||||
my $index = $surveyOrderIndexByVariableName->{$variable};
|
||||
my $address = $surveyOrder->[$index];
|
||||
my $answerAddress;
|
||||
|
||||
# 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;
|
||||
|
|
@ -240,23 +246,23 @@ sub _test {
|
|||
$aIndex++;
|
||||
}
|
||||
if (!$answer || $answerAddress !~ m/\d+-\d+-\d+/) {
|
||||
return <<END_TAP;
|
||||
not ok $testCount - next $next
|
||||
# answerText $answerText does not match any answers in your survey
|
||||
END_TAP
|
||||
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);
|
||||
|
||||
return $self->_recordResponses( {
|
||||
responseJSON => $rJSON,
|
||||
responses => $responses,
|
||||
responses => $responses,
|
||||
surveyOrder => $surveyOrder,
|
||||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||
next => $next,
|
||||
testCount => $testCount,
|
||||
what => $what,
|
||||
});
|
||||
}
|
||||
|
||||
|
|
@ -300,6 +306,9 @@ sub _test_mc {
|
|||
my $aIndex = 0;
|
||||
for my $spec (@specs) {
|
||||
$self->_resetResponses($rJSON);
|
||||
# Test runs from $variable
|
||||
$rJSON->nextResponse($index);
|
||||
|
||||
my $responses = {};
|
||||
my $testCount = ++${$opts{testCount_ref}};
|
||||
|
||||
|
|
@ -318,6 +327,7 @@ sub _test_mc {
|
|||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||
next => $next,
|
||||
testCount => $testCount,
|
||||
what => "$variable mc answer " . ($aIndex + 1) . " jumps to $next",
|
||||
});
|
||||
|
||||
$aIndex++;
|
||||
|
|
@ -340,6 +350,7 @@ sub _recordResponses {
|
|||
surveyOrderIndexByVariableName => { type => HASHREF },
|
||||
next => 1,
|
||||
testCount => 1,
|
||||
what => 0,
|
||||
});
|
||||
|
||||
# assemble the top-level ingredients..
|
||||
|
|
@ -349,6 +360,7 @@ sub _recordResponses {
|
|||
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
||||
my $next = $opts{next};
|
||||
my $testCount = $opts{testCount};
|
||||
my $what = $opts{what};
|
||||
|
||||
$rJSON->recordResponses($responses);
|
||||
|
||||
|
|
@ -373,16 +385,35 @@ sub _recordResponses {
|
|||
|
||||
my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
|
||||
if ($nextResponse != $expectedNextResponse) {
|
||||
chomp (my $tap = <<END_TAP);
|
||||
not ok $testCount - next $next
|
||||
# Compared next section/question
|
||||
# got : $got
|
||||
# expect : $next
|
||||
END_TAP
|
||||
return $tap;
|
||||
return fail($testCount, $what, <<END_WHY);
|
||||
Compared next section/question
|
||||
got : $got
|
||||
expect : $next
|
||||
END_WHY
|
||||
}
|
||||
|
||||
return "ok $testCount";
|
||||
return pass($testCount, $what);
|
||||
}
|
||||
|
||||
sub pass {
|
||||
my ($testCount, $what, $extra) = @_;
|
||||
my $out = $what ? "ok $testCount - $what" : "ok $testCount";
|
||||
if ($extra) {
|
||||
$extra =~ s/^/# /gm;
|
||||
$out .= "\n$extra";
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub fail {
|
||||
my ($testCount, $what, $extra) = @_;
|
||||
my $out = $what ? "not ok $testCount - $what" : "not ok $testCount";
|
||||
if ($extra) {
|
||||
chomp($extra);
|
||||
$extra =~ s/^/# /gm;
|
||||
$out .= "\n$extra";
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
plan tests => 16;
|
||||
plan tests => 22;
|
||||
|
||||
my ( $s, $t1 );
|
||||
|
||||
|
|
@ -41,25 +41,31 @@ $s->responseIdCookies(0);
|
|||
|
||||
# Load bare-bones survey, containing a single section (S0)
|
||||
$s->surveyJSON_update( [0], { variable => 'S0' } );
|
||||
|
||||
# Section 0 has a single question, S0Q0, which is a Yes/No muti-choice
|
||||
$s->surveyJSON_newObject( [0] ); # S0Q0
|
||||
$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 0, 0 ], 'Yes/No' );
|
||||
|
||||
# Add a new section (S1)
|
||||
$s->surveyJSON_newObject( [0] );
|
||||
$s->surveyJSON_newObject( [] );
|
||||
$s->surveyJSON_update( [1], { variable => 'S1' } );
|
||||
$s->surveyJSON_newObject( [1] );
|
||||
$s->surveyJSON_newObject( [1] );
|
||||
$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
|
||||
$s->surveyJSON_update( [ 1, 1 ], { variable => 'S1Q1' } );
|
||||
$s->surveyJSON_newObject( [] );
|
||||
$s->surveyJSON_newObject( [2] );
|
||||
$s->surveyJSON_newObject( [] );
|
||||
|
||||
$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
|
||||
$s->surveyJSON_update( [1], { variable => 'S1' } );
|
||||
$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
|
||||
$s->surveyJSON_update( [ 1, 1 ], { variable => 'S1Q1' } );
|
||||
$s->surveyJSON_update( [2], { variable => 'S2' } );
|
||||
$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
|
||||
$s->surveyJSON_update( [3], { variable => 'S3' } );
|
||||
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 0, 0 ], 'Yes/No' );
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 1, 0 ], 'Yes/No' );
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 1, 1 ], 'Yes/No' );
|
||||
|
||||
$s->persistSurveyJSON;
|
||||
|
||||
cmp_deeply(
|
||||
$s->responseJSON->surveyOrder,
|
||||
[ [ 0, 0, [ 0, 1 ] ], [ 1, 0, [0] ], [ 1, 1, [0] ] ],
|
||||
[ [ 0, 0, [ 0, 1 ] ], [ 1, 0, [0, 1] ], [ 1, 1, [0, 1] ], [ 2, 0, [0] ], [ 3 ] ],
|
||||
'At this stage our surveyOrder has 3 items'
|
||||
);
|
||||
|
||||
|
|
@ -70,102 +76,143 @@ cmp_deeply(
|
|||
'S1' => 1,
|
||||
'S1Q0' => 1,
|
||||
'S1Q1' => 2,
|
||||
'S2' => 3,
|
||||
'S2Q0' => 3,
|
||||
'S3' => 4,
|
||||
},
|
||||
'..which corresponds to'
|
||||
);
|
||||
|
||||
$t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } );
|
||||
my ($spec, $tap);
|
||||
my $spec;
|
||||
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
test : {
|
||||
S0Q0 : 'Yes',
|
||||
next : "S1",
|
||||
"test" : {
|
||||
"S0Q0" : "Yes",
|
||||
"next" : "S1",
|
||||
}
|
||||
},
|
||||
{
|
||||
test : {
|
||||
S0Q0 : 'No',
|
||||
next : "S1",
|
||||
"test" : {
|
||||
"S0Q0" : "No",
|
||||
"next" : "S1",
|
||||
}
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
$tap = <<END_TAP;
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1
|
||||
ok 2
|
||||
ok 1 - jumps to S1
|
||||
ok 2 - jumps to S1
|
||||
END_TAP
|
||||
try_it($t1, $spec, { tap => $tap });
|
||||
|
||||
# add a goto into the mix
|
||||
$s->surveyJSON_update( [ 0, 0, 0 ], { goto => 'S1Q1' } );
|
||||
|
||||
# deliberately pass in a spec that will fail
|
||||
$spec = <<END_SPEC;
|
||||
[ { test : {
|
||||
S0Q0 : 'Yes',
|
||||
next : "S1", # this will fail here, because Yes now jumps to S1Q1
|
||||
}
|
||||
},
|
||||
{ test : {
|
||||
S0Q0 : 'No',
|
||||
next : "S1",
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "Yes",
|
||||
"next" : "S1", # this will fail here, because Yes now jumps to S1Q1
|
||||
}
|
||||
},
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "No",
|
||||
"next" : "S1",
|
||||
}
|
||||
}
|
||||
} ]
|
||||
]
|
||||
END_SPEC
|
||||
my $tap2 = <<END_TAP;
|
||||
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
|
||||
1..2
|
||||
not ok 1 - next S1
|
||||
not ok 1 - jumps to S1
|
||||
# Compared next section/question
|
||||
# got : S1Q1 (<-- a question)
|
||||
# expect : S1
|
||||
ok 2
|
||||
ok 2 - jumps to S1
|
||||
END_TAP
|
||||
try_it($t1, $spec, { tap => $tap2, fail => 1 });
|
||||
|
||||
# try now with a spec that will pass
|
||||
$spec = <<END_SPEC;
|
||||
[ { test : {
|
||||
S0Q0 : 'Yes',
|
||||
next : "S1Q1", # jumps
|
||||
}
|
||||
},
|
||||
{ test : {
|
||||
S0Q0 : 'No',
|
||||
next : "S1", # falls through
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "Yes",
|
||||
"next" : "S1Q1", # jumps
|
||||
}
|
||||
},
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "No",
|
||||
"next" : "S1", # falls through
|
||||
}
|
||||
}
|
||||
} ]
|
||||
]
|
||||
END_SPEC
|
||||
try_it($t1, $spec, { tap => $tap });
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - jumps to S1Q1
|
||||
ok 2 - jumps to S1
|
||||
END_TAP
|
||||
|
||||
# Now use test_mc
|
||||
$spec = q{ [ { test_mc : [ 'S0Q0', 'S1Q1', 'S1' ] } ] };
|
||||
try_it($t1, $spec, { tap => $tap });
|
||||
$spec = q{ [ { "test_mc" : [ "S0Q0", "S1Q1", "S1" ] } ] };
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q1
|
||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
||||
END_TAP
|
||||
|
||||
# Now try one that doesn't start on the first page of the survey
|
||||
$spec = <<END_SPEC;
|
||||
[ { "test" : {
|
||||
"S1Q0" : "Yes",
|
||||
"S1Q0" : "No",
|
||||
"next" : "S2", # falls through
|
||||
}
|
||||
},
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - jumps to S2
|
||||
END_TAP
|
||||
|
||||
# And similarly a test_mc one that doesn't start on the first page
|
||||
$spec = q{ [ { "test_mc" : [ "S2Q0", "S3", "S3" ] } ] };
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S2Q0 mc answer 1 jumps to S3
|
||||
ok 2 - S2Q0 mc answer 2 jumps to S3
|
||||
END_TAP
|
||||
|
||||
use TAP::Parser;
|
||||
|
||||
sub try_it {
|
||||
my ($test, $spec, $opts) = @_;
|
||||
my ( $test, $spec, $opts ) = @_;
|
||||
chomp($spec);
|
||||
|
||||
|
||||
$test->update( { test => $spec } );
|
||||
my $result = $t1->run();
|
||||
ok( $result, 'Tests ran ok' );
|
||||
|
||||
if (my $tap = $opts->{tap}) {
|
||||
|
||||
if ( my $tap = $opts->{tap} ) {
|
||||
chomp($tap);
|
||||
is( $result->{tap}, $tap, 'TAP matches' );
|
||||
}
|
||||
|
||||
my $parser = TAP::Parser->new( $result );
|
||||
while (my $r = $parser->next) {
|
||||
|
||||
my $parser = TAP::Parser->new($result);
|
||||
while ( my $r = $parser->next ) {
|
||||
|
||||
# we could test extra stuff here, but mainly we just need to make the parser
|
||||
# go all the way through so that we can access ->has_problems
|
||||
}
|
||||
ok(!$parser->has_problems == !$opts->{fail}, ($opts->{fail} ? "Fails" : "Passes") . ' as expected');
|
||||
ok( !$parser->has_problems == !$opts->{fail}, ( $opts->{fail} ? "Fails" : "Passes" ) . ' as expected' );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue