Refactored Survey test suite diagnostics etc..
This commit is contained in:
parent
de47c22eff
commit
9cbd30c3d8
4 changed files with 355 additions and 78 deletions
|
|
@ -349,6 +349,18 @@ sub avg {
|
||||||
return sum(@vals) / @vals;
|
return sum(@vals) / @vals;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=head2 round
|
||||||
|
|
||||||
|
Utility sub shared with Safe compartment to allows expressions to easily round numbers
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub round {
|
||||||
|
my ($number, $precision) = @_;
|
||||||
|
$precision ||= 0;
|
||||||
|
return sprintf("%.${precision}f", $number);
|
||||||
|
}
|
||||||
|
|
||||||
=head2 run ( $session, $expression, $opts )
|
=head2 run ( $session, $expression, $opts )
|
||||||
|
|
||||||
Class method.
|
Class method.
|
||||||
|
|
@ -451,6 +463,7 @@ sub run {
|
||||||
$compartment->share('&exitUrl');
|
$compartment->share('&exitUrl');
|
||||||
$compartment->share('&restart');
|
$compartment->share('&restart');
|
||||||
$compartment->share('&avg');
|
$compartment->share('&avg');
|
||||||
|
$compartment->share('&round');
|
||||||
|
|
||||||
# Give them all of List::Util too
|
# Give them all of List::Util too
|
||||||
$compartment->share_from( 'List::Util',
|
$compartment->share_from( 'List::Util',
|
||||||
|
|
|
||||||
|
|
@ -148,6 +148,7 @@ sub run {
|
||||||
for my $item (@$spec) {
|
for my $item (@$spec) {
|
||||||
$self->_resetResponses($rJSON);
|
$self->_resetResponses($rJSON);
|
||||||
$rJSON->lastResponse(-1);
|
$rJSON->lastResponse(-1);
|
||||||
|
my $name = $item->{name};
|
||||||
if (my $args = $item->{test} ) {
|
if (my $args = $item->{test} ) {
|
||||||
push @tap, $self->_test( {
|
push @tap, $self->_test( {
|
||||||
responseJSON => $rJSON,
|
responseJSON => $rJSON,
|
||||||
|
|
@ -155,6 +156,7 @@ sub run {
|
||||||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||||
args => $args,
|
args => $args,
|
||||||
testCount_ref => \$testCount,
|
testCount_ref => \$testCount,
|
||||||
|
name => $name,
|
||||||
} );
|
} );
|
||||||
}
|
}
|
||||||
elsif (my $args = $item->{test_mc} ) {
|
elsif (my $args = $item->{test_mc} ) {
|
||||||
|
|
@ -164,6 +166,17 @@ sub run {
|
||||||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||||
args => $args,
|
args => $args,
|
||||||
testCount_ref => \$testCount,
|
testCount_ref => \$testCount,
|
||||||
|
name => $name,
|
||||||
|
} );
|
||||||
|
}
|
||||||
|
elsif (my $args = $item->{sequence} ) {
|
||||||
|
push @tap, $self->_sequence( {
|
||||||
|
responseJSON => $rJSON,
|
||||||
|
surveyOrder => $surveyOrder,
|
||||||
|
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||||
|
args => $args,
|
||||||
|
testCount_ref => \$testCount,
|
||||||
|
name => $name,
|
||||||
} );
|
} );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
|
@ -206,6 +219,7 @@ sub _test {
|
||||||
surveyOrderIndexByVariableName => { type => HASHREF },
|
surveyOrderIndexByVariableName => { type => HASHREF },
|
||||||
testCount_ref => { type => SCALARREF },
|
testCount_ref => { type => SCALARREF },
|
||||||
args => { type => HASHREF },
|
args => { type => HASHREF },
|
||||||
|
name => 0,
|
||||||
});
|
});
|
||||||
|
|
||||||
# assemble the top-level ingredients..
|
# assemble the top-level ingredients..
|
||||||
|
|
@ -213,12 +227,14 @@ sub _test {
|
||||||
my $surveyOrder = $opts{surveyOrder};
|
my $surveyOrder = $opts{surveyOrder};
|
||||||
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
||||||
my $args = $opts{args};
|
my $args = $opts{args};
|
||||||
|
my $name = $opts{name};
|
||||||
my $testCount = ++${$opts{testCount_ref}};
|
my $testCount = ++${$opts{testCount_ref}};
|
||||||
|
|
||||||
# ..and the test-specific arguments
|
# ..and the test-specific arguments
|
||||||
my ($next, $tags, $setup ) = @{$args}{qw(next tags setup)};
|
my ($next, $tagged, $score, $setup ) = @{$args}{qw(next tagged score setup)};
|
||||||
delete $args->{next};
|
delete $args->{next};
|
||||||
delete $args->{tags};
|
delete $args->{tagged};
|
||||||
|
delete $args->{score};
|
||||||
delete $args->{setup};
|
delete $args->{setup};
|
||||||
# n.b. everything left in %args assumed to be variable => answer_spec
|
# n.b. everything left in %args assumed to be variable => answer_spec
|
||||||
|
|
||||||
|
|
@ -255,7 +271,13 @@ sub _test {
|
||||||
elsif ( $questionType eq 'Text' || $questionType eq 'Number' ) {
|
elsif ( $questionType eq 'Text' || $questionType eq 'Number' ) {
|
||||||
# Assume spec is raw value to record in the single answer
|
# Assume spec is raw value to record in the single answer
|
||||||
$responses->{"$address->[0]-$address->[1]-0"} = $spec;
|
$responses->{"$address->[0]-$address->[1]-0"} = $spec;
|
||||||
}
|
} elsif ( $questionType eq 'Year Month' ) {
|
||||||
|
if ($spec !~ m/\d{4} \w+/) {
|
||||||
|
return fail($testCount, "Invalid input for Year Month question type", "Got: $spec\nExpected: YYYY Month");
|
||||||
|
}
|
||||||
|
$self->session->log->debug("Recording Year Month value: $spec");
|
||||||
|
$responses->{"$address->[0]-$address->[1]-0"} = $spec;
|
||||||
|
}
|
||||||
else {
|
else {
|
||||||
# Assume spec is the raw text of the answer we want
|
# Assume spec is the raw text of the answer we want
|
||||||
my $answer;
|
my $answer;
|
||||||
|
|
@ -282,10 +304,13 @@ sub _test {
|
||||||
|
|
||||||
my $pageSection = $rJSON->survey->section($surveyOrder->[$lowestIndex]);
|
my $pageSection = $rJSON->survey->section($surveyOrder->[$lowestIndex]);
|
||||||
my $pageQuestion = $rJSON->survey->question($surveyOrder->[$lowestIndex]);
|
my $pageQuestion = $rJSON->survey->question($surveyOrder->[$lowestIndex]);
|
||||||
my $what = "Page containing Section $pageSection->{variable}";
|
if (!$name) {
|
||||||
$what .= " Question $pageQuestion->{variable}" if $pageQuestion;
|
$name = "Checking ";
|
||||||
$what .= " jumps to $next" if $next;
|
my %what = ( next => $next, tagged => $tagged, score => $score );
|
||||||
$what .= " and tags data" if $tags;
|
$name .= join ' and ', (grep {$what{$_}} qw(next tagged score));
|
||||||
|
$name .= " on page containing Section $pageSection->{variable}";
|
||||||
|
$name .= " Question $pageQuestion->{variable}" if $pageQuestion;
|
||||||
|
}
|
||||||
|
|
||||||
return $self->_recordResponses( {
|
return $self->_recordResponses( {
|
||||||
responseJSON => $rJSON,
|
responseJSON => $rJSON,
|
||||||
|
|
@ -293,9 +318,10 @@ sub _test {
|
||||||
surveyOrder => $surveyOrder,
|
surveyOrder => $surveyOrder,
|
||||||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||||
next => $next,
|
next => $next,
|
||||||
tags => $tags,
|
tagged => $tagged,
|
||||||
|
score => $score,
|
||||||
testCount => $testCount,
|
testCount => $testCount,
|
||||||
what => $what,
|
name => $name,
|
||||||
});
|
});
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -316,6 +342,7 @@ sub _test_mc {
|
||||||
surveyOrderIndexByVariableName => { type => HASHREF },
|
surveyOrderIndexByVariableName => { type => HASHREF },
|
||||||
testCount_ref => { type => SCALARREF },
|
testCount_ref => { type => SCALARREF },
|
||||||
args => { type => ARRAYREF },
|
args => { type => ARRAYREF },
|
||||||
|
name => 0,
|
||||||
});
|
});
|
||||||
|
|
||||||
# assemble the top-level ingredients..
|
# assemble the top-level ingredients..
|
||||||
|
|
@ -348,9 +375,9 @@ sub _test_mc {
|
||||||
my $responses = {};
|
my $responses = {};
|
||||||
my $testCount = ++${$opts{testCount_ref}};
|
my $testCount = ++${$opts{testCount_ref}};
|
||||||
|
|
||||||
my ($next, $tags);
|
my ($next, $tagged, $score);
|
||||||
if (ref $spec eq 'HASH') {
|
if (ref $spec eq 'HASH') {
|
||||||
($next, $tags) = @{$spec}{qw(next tags)};
|
($next, $tagged, $score) = @{$spec}{qw(next tagged score)};
|
||||||
} else {
|
} else {
|
||||||
$next = $spec;
|
$next = $spec;
|
||||||
}
|
}
|
||||||
|
|
@ -359,10 +386,17 @@ sub _test_mc {
|
||||||
my $answer = $answers->[$aIndex];
|
my $answer = $answers->[$aIndex];
|
||||||
my $recordedAnswer = $answer->{recordedAnswer};
|
my $recordedAnswer = $answer->{recordedAnswer};
|
||||||
$responses->{$answerAddress} = $recordedAnswer;
|
$responses->{$answerAddress} = $recordedAnswer;
|
||||||
|
|
||||||
my $what = "$variable mc answer " . ($aIndex + 1);
|
my $name = $opts{name}; # get this fresh for every subtest
|
||||||
$what .= " jumps to $next" if $next;
|
if ($name) {
|
||||||
$what .= " and tags correct" if $tags;
|
# Add some extra diagnostic text since single test_mc generates multiple sub-tests
|
||||||
|
$name .= " mc answer " . ($aIndex + 1);
|
||||||
|
} else {
|
||||||
|
$name = "Checking ";
|
||||||
|
my %what = ( next => $next, tagged => $tagged, score => $score );
|
||||||
|
$name .= join ' and ', (grep {$what{$_}} qw(next tagged score));
|
||||||
|
$name .= " for $variable mc answer " . ($aIndex + 1);
|
||||||
|
}
|
||||||
|
|
||||||
$self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer");
|
$self->session->log->debug("Recording answer for mc question $variable at index $aIndex ($answerAddress) => $recordedAnswer");
|
||||||
push @tap, $self->_recordResponses( {
|
push @tap, $self->_recordResponses( {
|
||||||
|
|
@ -372,8 +406,9 @@ sub _test_mc {
|
||||||
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName,
|
||||||
next => $next,
|
next => $next,
|
||||||
testCount => $testCount,
|
testCount => $testCount,
|
||||||
what => $what,
|
name => $name,
|
||||||
tags => $tags,
|
tagged => $tagged,
|
||||||
|
score => $score,
|
||||||
});
|
});
|
||||||
|
|
||||||
$aIndex++;
|
$aIndex++;
|
||||||
|
|
@ -381,6 +416,79 @@ sub _test_mc {
|
||||||
return @tap;
|
return @tap;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=head2 _test
|
||||||
|
|
||||||
|
Private sub. Triggered when a test spec requests "sequence".
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub _sequence {
|
||||||
|
my $self = shift;
|
||||||
|
my %opts = validate(@_, {
|
||||||
|
responseJSON => { isa => 'WebGUI::Asset::Wobject::Survey::ResponseJSON' },
|
||||||
|
surveyOrder => { type => ARRAYREF },
|
||||||
|
surveyOrderIndexByVariableName => { type => HASHREF },
|
||||||
|
testCount_ref => { type => SCALARREF },
|
||||||
|
args => { type => HASHREF },
|
||||||
|
name => 0,
|
||||||
|
});
|
||||||
|
|
||||||
|
# assemble the top-level ingredients..
|
||||||
|
my $rJSON = $opts{responseJSON};
|
||||||
|
my $surveyOrder = $opts{surveyOrder};
|
||||||
|
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
||||||
|
my $args = $opts{args};
|
||||||
|
my $name = $opts{name};
|
||||||
|
my $testCount = ++${$opts{testCount_ref}};
|
||||||
|
|
||||||
|
# n.b. everything in %args assumed to be variable => spec
|
||||||
|
|
||||||
|
while ( my ( $variable, $spec ) = each %$args ) {
|
||||||
|
my $index = $surveyOrderIndexByVariableName->{$variable};
|
||||||
|
my $address = $surveyOrder->[$index];
|
||||||
|
my $question = $rJSON->survey->question($address);
|
||||||
|
my $questionType = $question->{questionType};
|
||||||
|
|
||||||
|
# Iterate over all answers
|
||||||
|
my ($recordedAnswer, $score);
|
||||||
|
my $recordedAnswerDelta
|
||||||
|
= $spec->{recordedAnswer} =~ m/desc/ ? -1
|
||||||
|
: $spec->{recordedAnswer} =~ m/asc/ ? 1
|
||||||
|
: $spec->{recordedAnswer} =~ m/cons/ ? 0
|
||||||
|
: undef;
|
||||||
|
|
||||||
|
my $scoreDelta
|
||||||
|
= $spec->{score} =~ m/desc/ ? -1
|
||||||
|
: $spec->{score} =~ m/asc/ ? 1
|
||||||
|
: $spec->{score} =~ m/cons/ ? 0
|
||||||
|
: undef;
|
||||||
|
|
||||||
|
my $aNum = 0;
|
||||||
|
for my $a (@{$question->{answers}}) {
|
||||||
|
$aNum++;
|
||||||
|
|
||||||
|
if (defined $recordedAnswerDelta && defined $recordedAnswer) {
|
||||||
|
my $expect = $recordedAnswer + $recordedAnswerDelta;
|
||||||
|
if ( $expect != $a->{recordedAnswer}) {
|
||||||
|
return fail($testCount, "$variable answer index $aNum recordedAnswer not in sequence", "Got: $a->{recordedAnswer}\nExpected: $expect");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (defined $scoreDelta && defined $score) {
|
||||||
|
my $expect = $score + $scoreDelta;
|
||||||
|
if ( $expect != $a->{value}) {
|
||||||
|
return fail($testCount, "$variable answer index $aNum score not in sequence", "Got: $a->{value}\nExpected: $expect");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$recordedAnswer = $a->{recordedAnswer};
|
||||||
|
$score = $a->{value};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return pass($testCount, "Valid sequences");
|
||||||
|
}
|
||||||
|
|
||||||
=head2 _recordResponses
|
=head2 _recordResponses
|
||||||
|
|
||||||
Private sub. Records responses and checks that you end up where you expect
|
Private sub. Records responses and checks that you end up where you expect
|
||||||
|
|
@ -396,8 +504,9 @@ sub _recordResponses {
|
||||||
surveyOrderIndexByVariableName => { type => HASHREF },
|
surveyOrderIndexByVariableName => { type => HASHREF },
|
||||||
next => 1,
|
next => 1,
|
||||||
testCount => 1,
|
testCount => 1,
|
||||||
what => 0,
|
name => 0,
|
||||||
tags => 0,
|
tagged => 0,
|
||||||
|
score => 0,
|
||||||
});
|
});
|
||||||
|
|
||||||
# assemble the top-level ingredients..
|
# assemble the top-level ingredients..
|
||||||
|
|
@ -407,8 +516,9 @@ sub _recordResponses {
|
||||||
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName};
|
||||||
my $next = $opts{next};
|
my $next = $opts{next};
|
||||||
my $testCount = $opts{testCount};
|
my $testCount = $opts{testCount};
|
||||||
my $what = $opts{what};
|
my $name = $opts{name};
|
||||||
my $tags = $opts{tags};
|
my $tagged = $opts{tagged};
|
||||||
|
my $score = $opts{score};
|
||||||
|
|
||||||
$rJSON->recordResponses($responses);
|
$rJSON->recordResponses($responses);
|
||||||
|
|
||||||
|
|
@ -431,30 +541,33 @@ sub _recordResponses {
|
||||||
}
|
}
|
||||||
my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
|
my $expectedNextResponse = $surveyOrderIndexByVariableName->{$next};
|
||||||
if ($nextResponse != $expectedNextResponse) {
|
if ($nextResponse != $expectedNextResponse) {
|
||||||
return fail($testCount, $what, <<END_WHY);
|
return fail($testCount, $name, <<END_WHY);
|
||||||
Compared next section/question
|
Compared next section/question
|
||||||
got : $got
|
got : $got
|
||||||
expect : '$next'
|
expect : '$next'
|
||||||
END_WHY
|
END_WHY
|
||||||
}
|
}
|
||||||
# Check tags, if asked
|
|
||||||
if ($tags && ref $tags eq 'ARRAY') {
|
# Check tagged, if asked
|
||||||
|
|
||||||
|
# Since tags are often boolean flags, allow them to optionally be specified as an array
|
||||||
|
if ($tagged && ref $tagged eq 'ARRAY') {
|
||||||
my $currentTags = $rJSON->tags;
|
my $currentTags = $rJSON->tags;
|
||||||
for my $tag (@$tags) {
|
for my $tag (@$tagged) {
|
||||||
my ($tagKey, $tagValue);
|
my ($tagKey, $tagValue);
|
||||||
if (ref $tag eq 'HASH') {
|
if (ref $tag eq 'HASH') {
|
||||||
($tagKey, $tagValue) = @$tag; # individual tag spec only has one key and one value
|
($tagKey, $tagValue) = %$tag; # individual tag spec only has one key and one value
|
||||||
} else {
|
} else {
|
||||||
($tagKey, $tagValue) = ($tag, 1); # defaults to 1 (boolean truth flag)
|
($tagKey, $tagValue) = ($tag, 1); # defaults to 1 (boolean truth flag)
|
||||||
}
|
}
|
||||||
if (!exists $currentTags->{$tagKey}) {
|
if (!exists $currentTags->{$tagKey}) {
|
||||||
$self->session->log->debug("Tag not found: $tagKey");
|
$self->session->log->debug("Tag not found: $tagKey");
|
||||||
return fail($testCount, $what, "Tag not found: $tagKey");
|
return fail($testCount, $name, "Tag not found: $tagKey");
|
||||||
}
|
}
|
||||||
my $currentTagValue = $currentTags->{$tagKey};
|
my $currentTagValue = $currentTags->{$tagKey};
|
||||||
if ($currentTagValue != $tagValue) {
|
if ($currentTagValue != $tagValue) {
|
||||||
$self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
|
$self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
|
||||||
return fail($testCount, $what, <<END_WHY);
|
return fail($testCount, $name, <<END_WHY);
|
||||||
Compared tag '$tagKey'
|
Compared tag '$tagKey'
|
||||||
got : '$currentTagValue'
|
got : '$currentTagValue'
|
||||||
expect : '$tagValue'
|
expect : '$tagValue'
|
||||||
|
|
@ -463,12 +576,44 @@ END_WHY
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return pass($testCount, $what);
|
# Alternatively, tags can be a hash
|
||||||
|
if ($tagged && ref $tagged eq 'HASH') {
|
||||||
|
my $currentTags = $rJSON->tags;
|
||||||
|
while (my ($tagKey, $tagValue) = each %$tagged) {
|
||||||
|
my $currentTagValue = $currentTags->{$tagKey};
|
||||||
|
if ($currentTagValue != $tagValue) {
|
||||||
|
$self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue");
|
||||||
|
return fail($testCount, $name, <<END_WHY);
|
||||||
|
Compared tag '$tagKey'
|
||||||
|
got : '$currentTagValue'
|
||||||
|
expect : '$tagValue'
|
||||||
|
END_WHY
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Check score, if asked
|
||||||
|
if ($score && ref $score eq 'HASH') {
|
||||||
|
my $currentScores = $rJSON->responseScoresByVariableName;
|
||||||
|
while (my ($scoreKey, $scoreValue) = each %$score) {
|
||||||
|
my $currentScore = $currentScores->{$scoreKey};
|
||||||
|
if ($currentScore != $scoreValue) {
|
||||||
|
$self->session->log->debug("Incorrect score: $currentScore != $scoreValue");
|
||||||
|
return fail($testCount, $name, <<END_WHY);
|
||||||
|
Compared score '$scoreKey'
|
||||||
|
got : '$currentScore'
|
||||||
|
expect : '$scoreValue'
|
||||||
|
END_WHY
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return pass($testCount, $name);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub pass {
|
sub pass {
|
||||||
my ($testCount, $what, $extra) = @_;
|
my ($testCount, $name, $extra) = @_;
|
||||||
my $out = $what ? "ok $testCount - $what" : "ok $testCount";
|
my $out = $name ? "ok $testCount - $name" : "ok $testCount";
|
||||||
if ($extra) {
|
if ($extra) {
|
||||||
$extra =~ s/^/# /gm;
|
$extra =~ s/^/# /gm;
|
||||||
$out .= "\n$extra";
|
$out .= "\n$extra";
|
||||||
|
|
@ -477,8 +622,8 @@ sub pass {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub fail {
|
sub fail {
|
||||||
my ($testCount, $what, $extra) = @_;
|
my ($testCount, $name, $extra) = @_;
|
||||||
my $out = $what ? "not ok $testCount - $what" : "not ok $testCount";
|
my $out = $name ? "not ok $testCount - $name" : "not ok $testCount";
|
||||||
if ($extra) {
|
if ($extra) {
|
||||||
chomp($extra);
|
chomp($extra);
|
||||||
$extra =~ s/^/# /gm;
|
$extra =~ s/^/# /gm;
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
# Tests
|
# Tests
|
||||||
my $tests = 56;
|
my $tests = 57;
|
||||||
plan tests => $tests + 1;
|
plan tests => $tests + 1;
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
|
|
@ -71,6 +71,7 @@ SKIP: {
|
||||||
q{jump { if (value(n) == 5) { 1 } else { 0 } } target}, # if statement
|
q{jump { if (value(n) == 5) { 1 } else { 0 } } target}, # if statement
|
||||||
q{jump { $q2 = 3; $avg = (value(n) + $q2) / 2; $avg == 4 } target}, # look ma, averages!
|
q{jump { $q2 = 3; $avg = (value(n) + $q2) / 2; $avg == 4 } target}, # look ma, averages!
|
||||||
q{jump { $q2 = 3; avg(value(n), $q2) == 4 } target}, # look ma, built-in avg sub!
|
q{jump { $q2 = 3; avg(value(n), $q2) == 4 } target}, # look ma, built-in avg sub!
|
||||||
|
q{jump { round(3.456) == 3 && round(3.456, 2) == 3.46 } target}, # rounding
|
||||||
q{jump { value(n) == 5 } target; jump { value(n) == 5 } targetX}, # first jump wins
|
q{jump { value(n) == 5 } target; jump { value(n) == 5 } targetX}, # first jump wins
|
||||||
q{jump { value(n) == 0 } targetX; jump { value(n) == 5 } target}, # false jumps ignored
|
q{jump { value(n) == 0 } targetX; jump { value(n) == 5 } target}, # false jumps ignored
|
||||||
q{jump { min(3,5,2) == 2 } target}, # List::Util min
|
q{jump { min(3,5,2) == 2 } target}, # List::Util min
|
||||||
|
|
|
||||||
|
|
@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
#----------------------------------------------------------------------------
|
||||||
# Tests
|
# Tests
|
||||||
plan tests => 34;
|
plan tests => 52;
|
||||||
|
|
||||||
my ( $s, $t1 );
|
my ( $s, $t1 );
|
||||||
|
|
||||||
|
|
@ -46,13 +46,12 @@ $s->surveyJSON_newObject( [] ); # S1
|
||||||
$s->surveyJSON_newObject( [] ); # S2
|
$s->surveyJSON_newObject( [] ); # S2
|
||||||
$s->surveyJSON_newObject( [] ); # S3
|
$s->surveyJSON_newObject( [] ); # S3
|
||||||
$s->surveyJSON_newObject( [] ); # S4
|
$s->surveyJSON_newObject( [] ); # S4
|
||||||
|
$s->surveyJSON_newObject( [] ); # S5
|
||||||
|
|
||||||
# Name the sections
|
# Name the sections
|
||||||
$s->surveyJSON_update( [0], { variable => 'S0' } );
|
for my $sIndex (0..5) {
|
||||||
$s->surveyJSON_update( [1], { variable => 'S1' } );
|
$s->surveyJSON_update( [$sIndex], { variable => "S$sIndex" } );
|
||||||
$s->surveyJSON_update( [2], { variable => 'S2' } );
|
}
|
||||||
$s->surveyJSON_update( [3], { variable => 'S3' } );
|
|
||||||
$s->surveyJSON_update( [4], { variable => 'S4' } );
|
|
||||||
|
|
||||||
# ..and now some questions
|
# ..and now some questions
|
||||||
$s->surveyJSON_newObject( [0] ); # S0Q0
|
$s->surveyJSON_newObject( [0] ); # S0Q0
|
||||||
|
|
@ -60,8 +59,8 @@ $s->surveyJSON_newObject( [1] ); # S1Q0
|
||||||
$s->surveyJSON_newObject( [2] ); # S2Q0
|
$s->surveyJSON_newObject( [2] ); # S2Q0
|
||||||
$s->surveyJSON_newObject( [3] ); # S3Q0
|
$s->surveyJSON_newObject( [3] ); # S3Q0
|
||||||
$s->surveyJSON_newObject( [3] ); # S3Q1
|
$s->surveyJSON_newObject( [3] ); # S3Q1
|
||||||
|
$s->surveyJSON_newObject( [3] ); # S3Q2
|
||||||
$s->surveyJSON_newObject( [4] ); # S4Q0
|
$s->surveyJSON_newObject( [4] ); # S4Q0
|
||||||
$s->surveyJSON_newObject( [4] ); # S4Q1
|
|
||||||
|
|
||||||
# Name the questions
|
# Name the questions
|
||||||
$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
|
$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
|
||||||
|
|
@ -69,16 +68,24 @@ $s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
|
||||||
$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
|
$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
|
||||||
$s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } );
|
$s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } );
|
||||||
$s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } );
|
$s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } );
|
||||||
|
$s->surveyJSON_update( [ 3, 2 ], { variable => 'S3Q2' } );
|
||||||
$s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } );
|
$s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } );
|
||||||
$s->surveyJSON_update( [ 4, 1 ], { variable => 'S4Q1' } );
|
|
||||||
|
|
||||||
# Set additional options..
|
# Set additional options..
|
||||||
$s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No
|
$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( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tagged data
|
||||||
|
|
||||||
$s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No
|
$s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No
|
||||||
$s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3' } ); # S1Q0 answer 0 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
|
$s->surveyJSON_update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0', 999); } } );# S1Q0 answer 1 tagged numeric data
|
||||||
|
|
||||||
|
$s->surveyJSON_update( [ 3 ], { gotoExpression => q{ jump { score(S3) == 0 } S5; } } ); # jump to S5 if all 3 questions answered as No
|
||||||
|
for my $qIndex (0..2) {
|
||||||
|
$s->surveyJSON_update( [ 3, $qIndex ], { questionType => 'Yes/No', required => 1 } );
|
||||||
|
$s->surveyJSON_update( [ 3, $qIndex, 1 ], { value => 0 } ); # Set 'No' score to 0
|
||||||
|
}
|
||||||
|
|
||||||
|
$s->surveyJSON_update( [ 4, 0 ], { questionType => 'Concern' } );
|
||||||
|
|
||||||
# And finally, persist the changes..
|
# And finally, persist the changes..
|
||||||
$s->persistSurveyJSON;
|
$s->persistSurveyJSON;
|
||||||
|
|
@ -87,14 +94,14 @@ cmp_deeply(
|
||||||
$s->responseJSON->surveyOrder, [
|
$s->responseJSON->surveyOrder, [
|
||||||
[ 0, 0, [ 0, 1 ] ], # S0Q0
|
[ 0, 0, [ 0, 1 ] ], # S0Q0
|
||||||
[ 1, 0, [ 0, 1 ] ], # S1Q0
|
[ 1, 0, [ 0, 1 ] ], # S1Q0
|
||||||
[ 2, 0, [] ], # S2Q0
|
[ 2, 0, [] ], # S2Q0
|
||||||
[ 3, 0, [] ], # S3Q0
|
[ 3, 0, [ 0, 1 ] ], # S3Q0
|
||||||
[ 3, 1, [] ], # S3Q1
|
[ 3, 1, [ 0, 1 ] ], # S3Q1
|
||||||
[ 4, 0, [] ], # S4Q0
|
[ 3, 2, [ 0, 1 ] ], # S3Q2
|
||||||
[ 4, 1, [] ], # S4Q1
|
[ 4, 0, [ 0 .. 10 ] ], # S4Q0
|
||||||
|
[ 5 ], # S5
|
||||||
], 'surveyOrder is correct'
|
], 'surveyOrder is correct'
|
||||||
);
|
);
|
||||||
|
|
||||||
cmp_deeply(
|
cmp_deeply(
|
||||||
$s->responseJSON->surveyOrderIndexByVariableName,
|
$s->responseJSON->surveyOrderIndexByVariableName,
|
||||||
{
|
{
|
||||||
|
|
@ -107,9 +114,10 @@ cmp_deeply(
|
||||||
'S3' => 3,
|
'S3' => 3,
|
||||||
'S3Q0' => 3,
|
'S3Q0' => 3,
|
||||||
'S3Q1' => 4,
|
'S3Q1' => 4,
|
||||||
'S4' => 5,
|
'S3Q2' => 5,
|
||||||
'S4Q0' => 5,
|
'S4' => 6,
|
||||||
'S4Q1' => 6,
|
'S4Q0' => 6,
|
||||||
|
'S5' => 7,
|
||||||
},
|
},
|
||||||
'surveyOrderIndexByVariableName correct'
|
'surveyOrderIndexByVariableName correct'
|
||||||
);
|
);
|
||||||
|
|
@ -140,8 +148,8 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..2
|
1..2
|
||||||
ok 1 - Page containing Section S0 Question S0Q0 jumps to S1
|
ok 1 - Checking next on page containing Section S0 Question S0Q0
|
||||||
ok 2 - Page containing Section S0 Question S0Q0 jumps to S1Q0
|
ok 2 - Checking next on page containing Section S0 Question S0Q0
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# deliberately pass in a spec that will fail
|
# deliberately pass in a spec that will fail
|
||||||
|
|
@ -157,12 +165,31 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
|
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
|
||||||
1..1
|
1..1
|
||||||
not ok 1 - Page containing Section S0 Question S0Q0 jumps to S2
|
not ok 1 - Checking next on page containing Section S0 Question S0Q0
|
||||||
# Compared next section/question
|
# Compared next section/question
|
||||||
# got : 'S1' (<-- a section) and 'S1Q0' (<-- a question)
|
# got : 'S1' (<-- a section) and 'S1Q0' (<-- a question)
|
||||||
# expect : 'S2'
|
# expect : 'S2'
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
|
# also fails if we don't answer all required questions
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"test" : {
|
||||||
|
"S3Q0" : "Yes",
|
||||||
|
"next" : "S4", # fails because we missed S3Q1 and S3Q2
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
|
||||||
|
1..1
|
||||||
|
not ok 1 - Checking next on page containing Section S3 Question S3Q0
|
||||||
|
# Compared next section/question
|
||||||
|
# got : 'S3' (<-- a section) and 'S3Q0' (<-- a question)
|
||||||
|
# expect : 'S4'
|
||||||
|
END_TAP
|
||||||
|
|
||||||
# now try it on a question that has branching, and doesn't start on the first page
|
# now try it on a question that has branching, and doesn't start on the first page
|
||||||
$spec = <<END_SPEC;
|
$spec = <<END_SPEC;
|
||||||
[
|
[
|
||||||
|
|
@ -176,24 +203,75 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..1
|
1..1
|
||||||
ok 1 - Page containing Section S1 Question S1Q0 jumps to S3
|
ok 1 - Checking next on page containing Section S1 Question S1Q0
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# Use tags..
|
# use our own description
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"test" : {
|
||||||
|
"S1Q0" : "Yes",
|
||||||
|
"next" : "S3", # a goto jump
|
||||||
|
},
|
||||||
|
"name" : "my individual test label"
|
||||||
|
},
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
|
1..1
|
||||||
|
ok 1 - my individual test label
|
||||||
|
END_TAP
|
||||||
|
|
||||||
|
## Use tagged..
|
||||||
$spec = <<END_SPEC;
|
$spec = <<END_SPEC;
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
"test" : {
|
"test" : {
|
||||||
"S0Q0" : "Yes",
|
"S0Q0" : "Yes",
|
||||||
"next" : "S1",
|
"next" : "S1",
|
||||||
"tags" : [ "tagged at S0Q0" ], # and tagged correctly
|
"tagged" : [ "tagged at S0Q0" ], # and tagged correctly
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
]
|
]
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..1
|
1..1
|
||||||
ok 1 - Page containing Section S0 Question S0Q0 jumps to S1 and tags data
|
ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
|
||||||
|
END_TAP
|
||||||
|
|
||||||
|
# Same but more verbose
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"test" : {
|
||||||
|
"S0Q0" : "Yes",
|
||||||
|
"next" : "S1",
|
||||||
|
"tagged" : [ { "tagged at S0Q0" : 1 }, ], # and tagged correctly
|
||||||
|
}
|
||||||
|
},
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
|
1..1
|
||||||
|
ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
|
||||||
|
END_TAP
|
||||||
|
|
||||||
|
# Also the same (uses hash instead of array)
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"test" : {
|
||||||
|
"S0Q0" : "Yes",
|
||||||
|
"next" : "S1",
|
||||||
|
"tagged" : { "tagged at S0Q0" : 1 },
|
||||||
|
}
|
||||||
|
},
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
|
1..1
|
||||||
|
ok 1 - Checking next and tagged on page containing Section S0 Question S0Q0
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# Use setup..
|
# Use setup..
|
||||||
|
|
@ -201,17 +279,17 @@ $spec = <<END_SPEC;
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
"test" : {
|
"test" : {
|
||||||
"setup" : { "S0Q0" : "Yes" }, # S0Q0 tags 'tagged at S0Q0'
|
"setup" : { "S0Q0" : "Yes" }, # S0Q0 tagged 'tagged at S0Q0'
|
||||||
"S1Q0" : "No",
|
"S1Q0" : "No",
|
||||||
"next" : "S2",
|
"next" : "S2",
|
||||||
"tags" : [ "tagged at S0Q0" ], # tagged by setup step
|
"tagged" : [ "tagged at S0Q0" ], # tagged by setup step
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
]
|
]
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..1
|
1..1
|
||||||
ok 1 - Page containing Section S1 Question S1Q0 jumps to S2 and tags data
|
ok 1 - Checking next and tagged on page containing Section S1 Question S1Q0
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# Use nested setup..
|
# Use nested setup..
|
||||||
|
|
@ -221,20 +299,39 @@ $spec = <<END_SPEC;
|
||||||
"test" : {
|
"test" : {
|
||||||
"setup" : {
|
"setup" : {
|
||||||
"setup" : {
|
"setup" : {
|
||||||
"S0Q0" : "Yes" # tags 'tagged at S0Q0'
|
"S0Q0" : "Yes" # tagged 'tagged at S0Q0'
|
||||||
},
|
},
|
||||||
"S1Q0" : "No", # tags 'tagged at S1Q0'
|
"S1Q0" : "No", # tagged 'tagged at S1Q0' with value 999
|
||||||
},
|
},
|
||||||
"S2Q0" : null,
|
"S2Q0" : null,
|
||||||
"next" : "S3",
|
"next" : "S3",
|
||||||
"tags" : [ "tagged at S0Q0", "tagged at S1Q0", ], # tagged by setup step
|
"tagged" : [ "tagged at S0Q0", { "tagged at S1Q0" : 999 }, ], # tagged by setup step
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
]
|
]
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..1
|
1..1
|
||||||
ok 1 - Page containing Section S2 Question S2Q0 jumps to S3 and tags data
|
ok 1 - Checking next and tagged on page containing Section S2 Question S2Q0
|
||||||
|
END_TAP
|
||||||
|
|
||||||
|
# Use the score option
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"test" : {
|
||||||
|
"S3Q0" : "n",
|
||||||
|
"S3Q1" : "y",
|
||||||
|
"S3Q2" : "y",
|
||||||
|
"next" : "S4",
|
||||||
|
"score" : { "S3" : 2 },
|
||||||
|
}
|
||||||
|
},
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
|
1..1
|
||||||
|
ok 1 - Checking next and score on page containing Section S3 Question S3Q0
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
#########
|
#########
|
||||||
|
|
@ -254,8 +351,8 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..2
|
1..2
|
||||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
ok 1 - Checking next for S0Q0 mc answer 1
|
||||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
ok 2 - Checking next for S0Q0 mc answer 2
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# try the same thing, but in a more verbose form
|
# try the same thing, but in a more verbose form
|
||||||
|
|
@ -272,18 +369,18 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..2
|
1..2
|
||||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0
|
ok 1 - Checking next for S0Q0 mc answer 1
|
||||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
ok 2 - Checking next for S0Q0 mc answer 2
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# use the tags option
|
# use the tagged option
|
||||||
$spec = <<END_SPEC;
|
$spec = <<END_SPEC;
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
"test_mc" : [
|
"test_mc" : [
|
||||||
"S0Q0", # test S0Q0
|
"S0Q0", # test S0Q0
|
||||||
{ "next" : "S1Q0", # first answer falls through
|
{ "next" : "S1Q0", # first answer falls through
|
||||||
"tags" : [ "tagged at S0Q0" ], # and tags data
|
"tagged" : [ "tagged at S0Q0" ], # and tagged data
|
||||||
},
|
},
|
||||||
{ "next" : "S1" }, # second answer falls through to the same place
|
{ "next" : "S1" }, # second answer falls through to the same place
|
||||||
]
|
]
|
||||||
|
|
@ -292,8 +389,8 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..2
|
1..2
|
||||||
ok 1 - S0Q0 mc answer 1 jumps to S1Q0 and tags correct
|
ok 1 - Checking next and tagged for S0Q0 mc answer 1
|
||||||
ok 2 - S0Q0 mc answer 2 jumps to S1
|
ok 2 - Checking next for S0Q0 mc answer 2
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
# And try one that does branching, and doesn't start on the first page
|
# And try one that does branching, and doesn't start on the first page
|
||||||
|
|
@ -303,7 +400,7 @@ $spec = <<END_SPEC;
|
||||||
"test_mc" : [
|
"test_mc" : [
|
||||||
"S1Q0", # test S1Q0
|
"S1Q0", # test S1Q0
|
||||||
{ "next" : "S3", # first answer jumps
|
{ "next" : "S3", # first answer jumps
|
||||||
"tags" : [ ], # nothing gets tagged
|
"tagged" : [ ], # nothing gets tagged
|
||||||
},
|
},
|
||||||
{ "next" : "S2" }, # second answer falls through
|
{ "next" : "S2" }, # second answer falls through
|
||||||
]
|
]
|
||||||
|
|
@ -312,8 +409,29 @@ $spec = <<END_SPEC;
|
||||||
END_SPEC
|
END_SPEC
|
||||||
try_it( $t1, $spec, { tap => <<END_TAP } );
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
1..2
|
1..2
|
||||||
ok 1 - S1Q0 mc answer 1 jumps to S3 and tags correct
|
ok 1 - Checking next and tagged for S1Q0 mc answer 1
|
||||||
ok 2 - S1Q0 mc answer 2 jumps to S2
|
ok 2 - Checking next for S1Q0 mc answer 2
|
||||||
|
END_TAP
|
||||||
|
|
||||||
|
#########
|
||||||
|
# sequence
|
||||||
|
#########
|
||||||
|
$spec = <<END_SPEC;
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"sequence" : {
|
||||||
|
"S1Q0" : { "recordedAnswer" : "desc", "score" : "cons" }, # This is a default Yes/No (score all 1)
|
||||||
|
"S4Q0" : { "recordedAnswer" : "asc" }, # Certainty scale, with recordedAnswer 0 .. 11
|
||||||
|
"S3Q0" : { "recordedAnswer" : "desc", "score" : "desc" }, # These 3 are yes/no questions where we have
|
||||||
|
"S3Q1" : { "recordedAnswer" : "desc", "score" : "desc" }, # ..set the score on the No answer to zero, hence
|
||||||
|
"S3Q2" : { "recordedAnswer" : "desc", "score" : "desc" }, # ..they are descending
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
END_SPEC
|
||||||
|
try_it( $t1, $spec, { tap => <<END_TAP } );
|
||||||
|
1..1
|
||||||
|
ok 1 - Valid sequences
|
||||||
END_TAP
|
END_TAP
|
||||||
|
|
||||||
use TAP::Parser;
|
use TAP::Parser;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue