Made Survey ExpressionEngine disabled by default, controlled via config
file enableSurveyExpressionEngine flag Added branching based on question score and section score total Added more tests
This commit is contained in:
Patrick Donelan
parent
9ea4f1cd20
commit
a7cb9b031d
5 changed files with 211 additions and 63 deletions
|
|
@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 33;
|
||||
my $tests = 36;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -36,64 +36,78 @@ SKIP: {
|
|||
|
||||
my $e = "WebGUI::Asset::Wobject::Survey::ExpressionEngine";
|
||||
|
||||
my %vars = (
|
||||
is( $e->run( $session, 'jump { 1 } target' ),
|
||||
undef, "Nothing happens unless we turn on enableSurveyExpressionEngine in config" );
|
||||
WebGUI::Test->originalConfig('enableSurveyExpressionEngine');
|
||||
$session->config->set( 'enableSurveyExpressionEngine', 1 );
|
||||
is( $e->run( $session, 'jump { 1 } target' ), 'target', "..now we're in business!" );
|
||||
|
||||
my %values = (
|
||||
n => 5,
|
||||
s1 => 'my string',
|
||||
);
|
||||
|
||||
my %scores = (
|
||||
n1 => 1,
|
||||
n2 => 2,
|
||||
);
|
||||
|
||||
# These should all jump to 'target'
|
||||
my @should_pass = (
|
||||
q{jump { 1 } target},
|
||||
q{jump { return 1 } target},
|
||||
q{jump { "string" } target},
|
||||
q{jump { var(n) == 5 } target},
|
||||
q{jump { var(n) > 0 } target},
|
||||
q{jump { var(s1) eq "my string" } target},
|
||||
q{jump { var(s1) =~ m/my/ } target},
|
||||
q{jump { var(n) == 4 or var(n) == 5 } target},
|
||||
q{jump { var(n) == 5 && var(n) > 0 } target},
|
||||
q{jump { (var(n) > 1 ? 10 : 11) == 10 } target},
|
||||
q{jump { value(n) == 5 } target},
|
||||
q{jump { value(n) > 0 } target},
|
||||
q{jump { value(s1) eq "my string" } target},
|
||||
q{jump { value(s1) =~ m/my/ } target},
|
||||
q{jump { value(n) == 4 or value(n) == 5 } target},
|
||||
q{jump { value(n) == 5 && value(n) > 0 } target},
|
||||
q{jump { (value(n) > 1 ? 10 : 11) == 10 } target},
|
||||
q{jump { $a=1; $a++; $a++; $a *= 2; $a == 6 } target},
|
||||
q{jump { @a = (1..10); $a[0] == 1 && @a == 10 } target}, # arrays
|
||||
q{jump { if (var(n) == 5) { 1 } else { 0 } } target}, # if statement
|
||||
q{jump { $q2 = 3; $avg = (var(n) + $q2) / 2; $avg == 4 } target}, # look ma, averages!
|
||||
q{jump { $q2 = 3; avg(var(n), $q2) == 4 } target}, # look ma, built-in avg sub!
|
||||
q{jump { var(n) == 5 } target; jump { var(n) == 5 } targetX}, # first jump wins
|
||||
q{jump { var(n) == 0 } targetX; jump { var(n) == 5 } target}, # false jumps ignored
|
||||
q{jump { min(3,5,2) == 2 } target}, # List::Util min
|
||||
q{jump { sum(var(n),1,1,1) == 8 } target}, # List::Util sum, etc..
|
||||
q{jump { @a = (1..10); $a[0] == 1 && @a == 10 } target}, # arrays
|
||||
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) == 4 } target}, # look ma, built-in avg sub!
|
||||
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 { min(3,5,2) == 2 } target}, # List::Util min
|
||||
q{jump { sum(value(n),1,1,1) == 8 } target}, # List::Util sum, etc..
|
||||
q{jump { score(n1) == 1 && score(n2) == 2 } target}, # score() works
|
||||
);
|
||||
|
||||
my @should_fail = (
|
||||
q{}, # empty
|
||||
q{ return }, # empty
|
||||
q{1}, # doesn't call jump
|
||||
q|{|, # doesn't compile
|
||||
q{blah-dee-blah-blah}, # rubbish expression
|
||||
q{jump {} target}, # empty anon sub to jump
|
||||
q{jump { 0 } target}, # false sub to jump
|
||||
q{jump { var(n) == 500 } target},
|
||||
q{jump { var(s1) eq 'blah' } target},
|
||||
q{jump { time } target}, # time and other opcodes not allowed
|
||||
q{}, # empty
|
||||
q{ return }, # empty
|
||||
q{1}, # doesn't call jump
|
||||
q|{|, # doesn't compile
|
||||
q{blah-dee-blah-blah}, # rubbish expression
|
||||
q{jump {} target}, # empty anon sub to jump
|
||||
q{jump { 0 } target}, # false sub to jump
|
||||
q{jump { value(n) == 500 } target},
|
||||
q{jump { value(s1) eq 'blah' } target},
|
||||
q{jump { time } target}, # time and other opcodes not allowed
|
||||
);
|
||||
|
||||
for my $expr (@should_pass) {
|
||||
is( $e->run( $session, $expr, { vars => \%vars } ), 'target', "\"$expr\" jumps as expected" );
|
||||
is( $e->run( $session, $expr, { values => \%values, scores => \%scores } ),
|
||||
'target', "\"$expr\" jumps as expected" );
|
||||
}
|
||||
|
||||
for my $expr (@should_fail) {
|
||||
is( $e->run( $session, $expr, { vars => \%vars } ), undef, "\"$expr\" fails as expected" );
|
||||
is( $e->run( $session, $expr, { values => \%values, scores => \%scores } ),
|
||||
undef, "\"$expr\" fails as expected" );
|
||||
}
|
||||
|
||||
$e->run( $session, q{jump {$x = var(s1); $x = 'X'} target}, { vars => \%vars } );
|
||||
is( $vars{s1}, 'my string', "Expression can't modify vars" );
|
||||
$e->run( $session, q{jump {$x = value(s1); $x = 'X'} target}, { values => \%values } );
|
||||
is( $values{s1}, 'my string', "Expression can't modify values" );
|
||||
|
||||
like( $e->run( $session, '{', { validate => 1 } ), qr/Missing right curly/, "Validation option works" );
|
||||
|
||||
# Check validTargets option
|
||||
is( $e->run( $session, q{jump {1} target}, { vars => \%vars, validTargets => { a => 1 } } ),
|
||||
is( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { a => 1 } } ),
|
||||
undef, 'target is not valid' );
|
||||
is( $e->run( $session, q{jump {1} target}, { vars => \%vars, validTargets => { target => 1 } } ),
|
||||
is( $e->run( $session, q{jump {1} target}, { values => \%values, validTargets => { target => 1 } } ),
|
||||
'target', '..whereas now it is ok' );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 59;
|
||||
my $tests = 64;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -323,10 +323,35 @@ is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates');
|
|||
|
||||
####################################################
|
||||
#
|
||||
# processGotoExpression
|
||||
# responseScoresByVariableName
|
||||
#
|
||||
####################################################
|
||||
|
||||
$rJSON->survey->section([0])->{variable} = 's0';
|
||||
$rJSON->survey->section([1])->{variable} = 's1';
|
||||
$rJSON->survey->section([2])->{variable} = 's2';
|
||||
$rJSON->survey->section([3])->{variable} = 's3';
|
||||
$rJSON->survey->question([1,0])->{variable} = 's1q0';
|
||||
$rJSON->survey->question([1,1])->{variable} = 's1q1';
|
||||
$rJSON->survey->answer([1,0,0])->{value} = 100; # set answer score
|
||||
$rJSON->survey->answer([1,1,0])->{value} = 200; # set answer score
|
||||
cmp_deeply($rJSON->responseScoresByVariableName, {}, 'scores initially empty');
|
||||
|
||||
$rJSON->lastResponse(2);
|
||||
$rJSON->recordResponses({
|
||||
'1-0-0' => 'My chosen answer',
|
||||
'1-1-0' => 'My chosen answer',
|
||||
});
|
||||
cmp_deeply($rJSON->responseScoresByVariableName, { s1q0 => 100, s1q1 => 200, s1 => 300}, 'scores now reflect q answers and section totals');
|
||||
|
||||
####################################################
|
||||
#
|
||||
# processGotoExpression
|
||||
#
|
||||
####################################################
|
||||
# Turn on the survey Expression Engine
|
||||
WebGUI::Test->originalConfig('enableSurveyExpressionEngine');
|
||||
$session->config->set('enableSurveyExpressionEngine', 1);
|
||||
$rJSON->survey->section([0])->{variable} = 's0'; # our first test jump target
|
||||
$rJSON->survey->section([2])->{variable} = 's2'; # our second test jump target
|
||||
$rJSON->survey->question([1,0])->{variable} = 's1q0'; # a question variable to use in our expressions
|
||||
|
|
@ -343,18 +368,27 @@ is($rJSON->lastResponse, 4, 'lastResponse at 4 before any gotoExpressions proces
|
|||
$rJSON->processGotoExpression('blah-dee-blah-blah {');
|
||||
is($rJSON->lastResponse, 4, '..unchanged after duff expression');
|
||||
|
||||
$rJSON->processGotoExpression('jump { var(s1q0) == 4} s0');
|
||||
$rJSON->processGotoExpression('jump { value(s1q0) == 4} s0');
|
||||
is($rJSON->lastResponse, 4, '..unchanged after false expression');
|
||||
|
||||
$rJSON->processGotoExpression('jump { var(s1q0) == 4} s0; jump { var(s1q0) == 5} s0;');
|
||||
$rJSON->processGotoExpression('jump { value(s1q0) == 4} s0; jump { value(s1q0) == 5} s0;');
|
||||
is($rJSON->lastResponse, 4, '..similarly for multi-statement false expression');
|
||||
|
||||
$rJSON->processGotoExpression('jump { var(s1q0) == 3} s0');
|
||||
$rJSON->processGotoExpression('jump { value(s1q0) == 3} DUFF_TARGET');
|
||||
is($rJSON->lastResponse, 4, '..similarly for expression with invalid target');
|
||||
|
||||
$rJSON->processGotoExpression('jump { value(s1q0) == 3} s0');
|
||||
is($rJSON->lastResponse, -1, '..but updated to s0 after true expression');
|
||||
|
||||
$rJSON->processGotoExpression('jump { var(s1q0) == 4} s0; jump { var(s1q0) == 3} s2');
|
||||
$rJSON->processGotoExpression('jump { value(s1q0) == 4} s0; jump { value(s1q0) == 3} s2');
|
||||
is($rJSON->lastResponse, 4, '..changed again for multi-statement true expression');
|
||||
|
||||
$rJSON->processGotoExpression('jump { score(s1q0) == 100} s0');
|
||||
is($rJSON->lastResponse, -1, '..and again when score used');
|
||||
|
||||
$rJSON->processGotoExpression('jump { score("s1") == 300} s2');
|
||||
is($rJSON->lastResponse, 4, '..and again when section score total used');
|
||||
|
||||
$rJSON->responses({});
|
||||
$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue