SurveyJSON bug fixes
Fixed bug in SurveyJSON::update to stop it updating questionType when not asked Fixed unsafe reference bug in SurveyJSON::getMultipleChoiceBundle Added more Survey Test Suite tests
This commit is contained in:
Patrick Donelan
parent
e26980c68c
commit
4d181da7f9
4 changed files with 198 additions and 92 deletions
|
|
@ -651,8 +651,8 @@ sub update {
|
|||
$newQuestion = 1; # make note that a new question was created
|
||||
push @{ $self->questions($address) }, $object;
|
||||
}
|
||||
# We need to update all of the answers to reflect the new questionType
|
||||
if ( $properties->{questionType} ne $object->{questionType} ) {
|
||||
# If questionType supplied, see if we need to update all of the answers to reflect the new questionType
|
||||
if ( $properties->{questionType} && $properties->{questionType} ne $object->{questionType} ) {
|
||||
$self->updateQuestionAnswers( $address, $properties->{questionType} );
|
||||
}
|
||||
}
|
||||
|
|
@ -957,6 +957,11 @@ sub newAnswer {
|
|||
|
||||
Remove all existing answers and add a default set of answers to a question, based on question type.
|
||||
|
||||
N.B. You probably don't want to call this method directly to update a question's questionType, as it
|
||||
doesn't actually change the stored value of questionType. Instead, call:
|
||||
|
||||
$surveyJSON->update( $address, { questionType => "some question type" } );
|
||||
|
||||
=head3 $address
|
||||
|
||||
See L<"Address Parameter">. Determines question to add answers to.
|
||||
|
|
@ -1032,7 +1037,8 @@ sub getMultiChoiceBundle {
|
|||
my $self = shift;
|
||||
my ($type) = validate_pos( @_, { type => SCALAR | UNDEF } );
|
||||
|
||||
return $self->{multipleChoiceTypes}->{$type};
|
||||
# Return a cloned copy of the bundle structure
|
||||
return clone $self->{multipleChoiceTypes}->{$type};
|
||||
}
|
||||
|
||||
=head2 addAnswersToQuestion ($address, $answers)
|
||||
|
|
|
|||
|
|
@ -305,20 +305,28 @@ sub _test_mc {
|
|||
my @tap;
|
||||
my $aIndex = 0;
|
||||
for my $spec (@specs) {
|
||||
|
||||
# Reset responses between sub-tests
|
||||
$self->_resetResponses($rJSON);
|
||||
|
||||
# Test runs from $variable
|
||||
$rJSON->nextResponse($index);
|
||||
|
||||
my $responses = {};
|
||||
my $testCount = ++${$opts{testCount_ref}};
|
||||
|
||||
# assume spec can only be a target
|
||||
my $next = $spec;
|
||||
my ($next, $tags);
|
||||
if (ref $spec eq 'HASH') {
|
||||
($next, $tags) = @{$spec}{qw(next tags)};
|
||||
} else {
|
||||
$next = $spec;
|
||||
}
|
||||
|
||||
my $answerAddress = "$address->[0]-$address->[1]-$aIndex";
|
||||
my $answer = $answers->[$aIndex];
|
||||
my $recordedAnswer = $answer->{recordedAnswer};
|
||||
$responses->{$answerAddress} = $recordedAnswer;
|
||||
|
||||
$self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer");
|
||||
push @tap, $self->_recordResponses( {
|
||||
responseJSON => $rJSON,
|
||||
|
|
@ -328,6 +336,7 @@ sub _test_mc {
|
|||
next => $next,
|
||||
testCount => $testCount,
|
||||
what => "$variable mc answer " . ($aIndex + 1) . " jumps to $next",
|
||||
tags => $tags,
|
||||
});
|
||||
|
||||
$aIndex++;
|
||||
|
|
@ -351,6 +360,7 @@ sub _recordResponses {
|
|||
next => 1,
|
||||
testCount => 1,
|
||||
what => 0,
|
||||
tags => 0,
|
||||
});
|
||||
|
||||
# assemble the top-level ingredients..
|
||||
|
|
@ -361,6 +371,7 @@ sub _recordResponses {
|
|||
my $next = $opts{next};
|
||||
my $testCount = $opts{testCount};
|
||||
my $what = $opts{what};
|
||||
my $tags = $opts{tags};
|
||||
|
||||
$rJSON->recordResponses($responses);
|
||||
|
||||
|
|
@ -369,28 +380,51 @@ sub _recordResponses {
|
|||
my $nextAddress = $surveyOrder->[$nextResponse];
|
||||
my $nextSection = $rJSON->survey->section($nextAddress);
|
||||
my $nextQuestion = $rJSON->survey->question($nextAddress);
|
||||
|
||||
# Get the lowest section surveyOrderIndex from lookup
|
||||
my $got;
|
||||
my $svar = $nextSection->{variable};
|
||||
my $qvar = $nextQuestion->{variable};
|
||||
if ($surveyOrderIndexByVariableName->{$svar} == $nextResponse) {
|
||||
$got = "$svar (<-- a section)";
|
||||
$got .= " and $qvar (<-- a question)" if $qvar;
|
||||
$got = "'$svar' (<-- a section)";
|
||||
$got .= " and '$qvar' (<-- a question)" if $qvar;
|
||||
} elsif ($qvar) {
|
||||
$got = "$qvar (<-- a question)";
|
||||
$got = "'$qvar' (<-- a question)";
|
||||
} else {
|
||||
$got = 'Unknown!';
|
||||
}
|
||||
|
||||
my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
|
||||
if ($nextResponse != $expectedNextResponse) {
|
||||
return fail($testCount, $what, <<END_WHY);
|
||||
Compared next section/question
|
||||
got : $got
|
||||
expect : $next
|
||||
expect : '$next'
|
||||
END_WHY
|
||||
}
|
||||
# Check tags, if asked
|
||||
if ($tags && ref $tags eq 'ARRAY') {
|
||||
my $currentTags = $rJSON->tags;
|
||||
for my $tag (@$tags) {
|
||||
my ($tagKey, $tagValue);
|
||||
if (ref $tag eq 'HASH') {
|
||||
($tagKey, $tagValue) = @$tag; # individual tag spec only has one key and one value
|
||||
} else {
|
||||
($tagKey, $tagValue) = ($tag, 1); # defaults to 1 (boolean truth flag)
|
||||
}
|
||||
if (!exists $currentTags->{$tagKey}) {
|
||||
$self->session->log->debug("Tag not found: $tagKey");
|
||||
return fail($testCount, $what, "Tag not found: $tagKey");
|
||||
}
|
||||
my $currentTagValue = $currentTags->{$tagKey};
|
||||
if ($currentTagValue != $tagValue) {
|
||||
$self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
|
||||
return fail($testCount, $what, <<END_WHY);
|
||||
Compared tag '$tagKey'
|
||||
got : '$currentTagValue'
|
||||
expect : '$tagValue'
|
||||
END_WHY
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return pass($testCount, $what);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -43,9 +43,9 @@ $survey->surveyJSON_update([0], { variable => 'S0' });
|
|||
|
||||
# Add 2 questions to S0
|
||||
$survey->surveyJSON_newObject([0]); # S0Q0
|
||||
$survey->surveyJSON_update([0,0], { variable => 'S0Q0' });
|
||||
$survey->surveyJSON_update([0,0], { variable => 'S0Q0', questionType => 'Yes/No' });
|
||||
$survey->surveyJSON_newObject([0]); # S0Q1
|
||||
$survey->surveyJSON_update([0,1], { variable => 'S0Q1' });
|
||||
$survey->surveyJSON_update([0,1], { variable => 'S0Q1', questionType => 'Yes/No' });
|
||||
|
||||
# Add a new section (S1)
|
||||
$survey->surveyJSON_newObject([]); # S1
|
||||
|
|
@ -92,8 +92,8 @@ ok($s->responseId, '..(and similarly for responseId)');
|
|||
|
||||
# Restart the survey
|
||||
$s->submitQuestions({
|
||||
'0-0-0' => 'My chosen answer',
|
||||
'0-1-0' => 'My chosen answer',
|
||||
'0-0-0' => 'this text ignored',
|
||||
'0-1-0' => 'this text ignored',
|
||||
});
|
||||
|
||||
cmp_deeply(
|
||||
|
|
@ -103,13 +103,13 @@ cmp_deeply(
|
|||
'verbatim' => undef,
|
||||
'comment' => undef,
|
||||
'time' => num( time, 5 ),
|
||||
'value' => ''
|
||||
'value' => 1
|
||||
},
|
||||
'0-0-0' => {
|
||||
'verbatim' => undef,
|
||||
'comment' => undef,
|
||||
'time' => num( time, 5 ),
|
||||
'value' => ''
|
||||
'value' => 1
|
||||
},
|
||||
}
|
||||
),
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
plan tests => 22;
|
||||
plan tests => 25;
|
||||
|
||||
my ( $s, $t1 );
|
||||
|
||||
|
|
@ -39,53 +39,88 @@ isa_ok( $s, 'WebGUI::Asset::Wobject::Survey' );
|
|||
|
||||
$s->responseIdCookies(0);
|
||||
|
||||
# Load bare-bones survey, containing a single section (S0)
|
||||
# N.B. Survey starts off with a single empty section (S0)
|
||||
|
||||
# Add some sections and questions
|
||||
$s->surveyJSON_newObject( [] ); # S1
|
||||
$s->surveyJSON_newObject( [] ); # S2
|
||||
$s->surveyJSON_newObject( [] ); # S3
|
||||
$s->surveyJSON_newObject( [] ); # S4
|
||||
|
||||
# Name the sections
|
||||
$s->surveyJSON_update( [0], { variable => 'S0' } );
|
||||
$s->surveyJSON_newObject( [0] );
|
||||
$s->surveyJSON_newObject( [] );
|
||||
$s->surveyJSON_newObject( [1] );
|
||||
$s->surveyJSON_newObject( [1] );
|
||||
$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_update( [4], { variable => 'S4' } );
|
||||
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 0, 0 ], 'Yes/No' );
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 1, 0 ], 'Yes/No' );
|
||||
$s->surveyJSON->updateQuestionAnswers( [ 1, 1 ], 'Yes/No' );
|
||||
# ..and now some questions
|
||||
$s->surveyJSON_newObject( [0] ); # S0Q0
|
||||
$s->surveyJSON_newObject( [1] ); # S1Q0
|
||||
$s->surveyJSON_newObject( [2] ); # S2Q0
|
||||
$s->surveyJSON_newObject( [3] ); # S3Q0
|
||||
$s->surveyJSON_newObject( [3] ); # S3Q1
|
||||
$s->surveyJSON_newObject( [4] ); # S4Q0
|
||||
$s->surveyJSON_newObject( [4] ); # S4Q1
|
||||
|
||||
# Name the questions
|
||||
$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
|
||||
$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
|
||||
$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
|
||||
$s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } );
|
||||
$s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } );
|
||||
$s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } );
|
||||
$s->surveyJSON_update( [ 4, 1 ], { variable => 'S4Q1' } );
|
||||
|
||||
# Set additional options..
|
||||
$s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No
|
||||
$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
|
||||
|
||||
# And finally, persist the changes..
|
||||
$s->persistSurveyJSON;
|
||||
|
||||
cmp_deeply(
|
||||
$s->responseJSON->surveyOrder,
|
||||
[ [ 0, 0, [ 0, 1 ] ], [ 1, 0, [0, 1] ], [ 1, 1, [0, 1] ], [ 2, 0, [0] ], [ 3 ] ],
|
||||
'At this stage our surveyOrder has 3 items'
|
||||
$s->responseJSON->surveyOrder, [
|
||||
[ 0, 0, [ 0, 1 ] ], # S0Q0
|
||||
[ 1, 0, [ 0, 1 ] ], # S1Q0
|
||||
[ 2, 0, [] ], # S2Q0
|
||||
[ 3, 0, [] ], # S3Q0
|
||||
[ 3, 1, [] ], # S3Q1
|
||||
[ 4, 0, [] ], # S4Q0
|
||||
[ 4, 1, [] ], # S4Q1
|
||||
], 'surveyOrder is correct'
|
||||
);
|
||||
|
||||
cmp_deeply(
|
||||
$s->responseJSON->surveyOrderIndexByVariableName,
|
||||
{ 'S0' => 0,
|
||||
$s->responseJSON->surveyOrderIndexByVariableName,
|
||||
{
|
||||
'S0' => 0,
|
||||
'S0Q0' => 0,
|
||||
'S1' => 1,
|
||||
'S1Q0' => 1,
|
||||
'S1Q1' => 2,
|
||||
'S2' => 3,
|
||||
'S2Q0' => 3,
|
||||
'S3' => 4,
|
||||
'S2' => 2,
|
||||
'S2Q0' => 2,
|
||||
'S3' => 3,
|
||||
'S3Q0' => 3,
|
||||
'S3Q1' => 4,
|
||||
'S4' => 5,
|
||||
'S4Q0' => 5,
|
||||
'S4Q1' => 6,
|
||||
},
|
||||
'..which corresponds to'
|
||||
'surveyOrderIndexByVariableName correct'
|
||||
);
|
||||
|
||||
$t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } );
|
||||
my $spec;
|
||||
|
||||
######
|
||||
# test
|
||||
######
|
||||
|
||||
# Both answers for S0Q0 jump to the next item, which can be referred to as either S1 or S1Q0
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
|
|
@ -97,7 +132,7 @@ $spec = <<END_SPEC;
|
|||
{
|
||||
"test" : {
|
||||
"S0Q0" : "No",
|
||||
"next" : "S1",
|
||||
"next" : "S1Q0",
|
||||
}
|
||||
}
|
||||
]
|
||||
|
|
@ -105,90 +140,121 @@ END_SPEC
|
|||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - jumps to S1
|
||||
ok 2 - jumps to S1
|
||||
ok 2 - jumps to S1Q0
|
||||
END_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",
|
||||
"next" : "S2", # wrong target, should fail
|
||||
}
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
|
||||
1..2
|
||||
not ok 1 - jumps to S1
|
||||
1..1
|
||||
not ok 1 - jumps to S2
|
||||
# Compared next section/question
|
||||
# got : S1Q1 (<-- a question)
|
||||
# expect : S1
|
||||
ok 2 - jumps to S1
|
||||
# got : 'S1' (<-- a section) and 'S1Q0' (<-- a question)
|
||||
# expect : 'S2'
|
||||
END_TAP
|
||||
|
||||
# try now with a spec that will pass
|
||||
# now try it on a question that has branching, and doesn't start on the first page
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "Yes",
|
||||
"next" : "S1Q1", # jumps
|
||||
"S1Q0" : "Yes",
|
||||
"next" : "S3", # a goto jumps
|
||||
}
|
||||
},
|
||||
{
|
||||
"test" : {
|
||||
"S0Q0" : "No",
|
||||
"next" : "S1", # falls through
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - jumps to S3
|
||||
END_TAP
|
||||
|
||||
#########
|
||||
# test_mc
|
||||
#########
|
||||
# Now use test_mc
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test_mc" : [
|
||||
"S0Q0", # from S0Q0
|
||||
"S1Q0", # first answer falls through
|
||||
"S1", # second answer falls through to the same place
|
||||
]
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
||||
END_TAP
|
||||
|
||||
# try the same thing, but in a more verbose form
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test_mc" : [
|
||||
"S0Q0", # from S0Q0
|
||||
{ "next" : "S1Q0" }, # first answer falls through
|
||||
{ "next" : "S1" }, # second answer falls through to the same place
|
||||
]
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
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 => <<END_TAP } );
|
||||
1..2
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q1
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
||||
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
|
||||
# use the tags option
|
||||
$spec = <<END_SPEC;
|
||||
[ { "test" : {
|
||||
"S1Q0" : "Yes",
|
||||
"S1Q0" : "No",
|
||||
"next" : "S2", # falls through
|
||||
}
|
||||
},
|
||||
[
|
||||
{
|
||||
"test_mc" : [
|
||||
"S0Q0", # test S0Q0
|
||||
{ "next" : "S1Q0", # first answer falls through
|
||||
"tags" : [ "tagged at S0Q0" ], # and tags data
|
||||
},
|
||||
{ "next" : "S1" }, # second answer falls through to the same place
|
||||
]
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||
1..1
|
||||
ok 1 - jumps to S2
|
||||
1..2
|
||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
||||
END_TAP
|
||||
|
||||
# And similarly a test_mc one that doesn't start on the first page
|
||||
$spec = q{ [ { "test_mc" : [ "S2Q0", "S3", "S3" ] } ] };
|
||||
# And try one that does branching, and doesn't start on the first page
|
||||
$spec = <<END_SPEC;
|
||||
[
|
||||
{
|
||||
"test_mc" : [
|
||||
"S1Q0", # test S1Q0
|
||||
{ "next" : "S3", # first answer jumps
|
||||
"tags" : [ ], # nothing gets tagged
|
||||
},
|
||||
{ "next" : "S2" }, # second answer falls through
|
||||
]
|
||||
}
|
||||
]
|
||||
END_SPEC
|
||||
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
|
||||
ok 1 - S1Q0 mc answer 1 jumps to S3
|
||||
ok 2 - S1Q0 mc answer 2 jumps to S2
|
||||
END_TAP
|
||||
|
||||
use TAP::Parser;
|
||||
|
|
@ -219,5 +285,5 @@ sub try_it {
|
|||
# Cleanup
|
||||
END {
|
||||
$s->purge() if $s;
|
||||
$t1->delete();
|
||||
$t1->delete() if $t1;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue