diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 0955ab720..b2107b338 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -154,8 +154,12 @@ sub run { for my $item (@$spec) { $rJSON->reset; my $name = $item->{name}; - my $args; - if ($args = $item->{test} ) { + my $setup = $item->{setup}; + + # N.B. we pass setup to individual test rather than running it for test, because + # some test subs reset rJSON between sub-tests + + if (my $args = $item->{test} ) { push @tap, $self->_test( { responseJSON => $rJSON, surveyOrder => $surveyOrder, @@ -163,9 +167,10 @@ sub run { args => $args, testCount_ref => \$testCount, name => $name, + setup => $setup, } ); } - elsif ($args = $item->{test_mc} ) { + elsif (my $args = $item->{test_mc} ) { push @tap, $self->_test_mc( { responseJSON => $rJSON, surveyOrder => $surveyOrder, @@ -173,9 +178,10 @@ sub run { args => $args, testCount_ref => \$testCount, name => $name, + setup => $setup, } ); } - elsif ($args = $item->{sequence} ) { + elsif (my $args = $item->{sequence} ) { push @tap, $self->_sequence( { responseJSON => $rJSON, surveyOrder => $surveyOrder, @@ -214,6 +220,7 @@ sub _test { testCount_ref => { type => SCALARREF }, args => { type => HASHREF }, name => 0, + setup => 1, }); # assemble the top-level ingredients.. @@ -222,10 +229,11 @@ sub _test { my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName}; my $args = $opts{args}; my $name = $opts{name}; + my $setup = $opts{setup} || $args->{setup}; # Setup option can also appear inside of test definition my $testCount = ++${$opts{testCount_ref}}; # ..and the test-specific arguments - my ($next, $tagged, $score, $page, $setup ) = @{$args}{qw(next tagged score page setup)}; + my ($next, $tagged, $score, $page) = @{$args}{qw(next tagged score page)}; delete $args->{next}; delete $args->{tagged}; delete $args->{score}; @@ -247,34 +255,12 @@ sub _test { surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, testCount_ref => \$fakeTestCount, args => $page, + setup => $setup, } ); } - # Setup any fake data the user wants prior to the test - if ($setup && ref $setup eq 'HASH') { - my %existingTags = %{$rJSON->tags}; - - # Process tags - # N.B. Make sure we add to existing tags instead of overwriting - if (ref $setup->{tag} eq 'HASH') { - # already a hash, so store it right away - $rJSON->tags( {%existingTags, %{$setup->{tag}} }); - } elsif (ref $setup->{tag} eq 'ARRAY') { - # turn array into hash before storing it - my $tags; - for my $tag (@{$setup->{tag}}) { - if (ref $tag eq 'HASH') { - # Individual item is a single key/value hash - my ($key, $value) = %$tag; - $tags->{$key} = $value; - } else { - # Individual item is a string, default to boolean truth flag - $tags->{$tag} = 1; # default to 1 - } - } - $rJSON->tags( {%existingTags, %$tags }); - } - } + # Run setup + $self->_setup( { responseJSON => $rJSON, setup => $setup } ); # Record responses my $responses = {}; @@ -293,7 +279,7 @@ sub _test { if (!defined $spec) { $self->session->log->debug("Spec undefined, assuming that means ignore answer value"); } - elsif ( $questionType eq 'Text' || $questionType eq 'Number' ) { + elsif ( $questionType eq 'Text' || $questionType eq 'Number' || $questionType eq 'Slider' ) { # Assume spec is raw value to record in the single answer $responses->{"$address->[0]-$address->[1]-0"} = $spec; } elsif ( $questionType eq 'Year Month' ) { @@ -352,6 +338,48 @@ sub _test { }); } +=head2 _setup + +Private sub. Used to setup tags etc.. on a ResponseJSON instance prior to tests being run. + +=cut + +sub _setup { + my $self = shift; + my %opts = validate(@_, { + responseJSON => { isa => 'WebGUI::Asset::Wobject::Survey::ResponseJSON' }, + setup => 1, + }); + + my ($rJSON, $setup) = @opts{'responseJSON', 'setup'}; + + # Setup any fake data the user wants prior to the test + if ($setup && ref $setup eq 'HASH') { + my %existingTags = %{$rJSON->tags}; + + # Process tags + # N.B. Make sure we add to existing tags instead of overwriting + if (ref $setup->{tag} eq 'HASH') { + # already a hash, so store it right away + $rJSON->tags( {%existingTags, %{$setup->{tag}} }); + } elsif (ref $setup->{tag} eq 'ARRAY') { + # turn array into hash before storing it + my $tags; + for my $tag (@{$setup->{tag}}) { + if (ref $tag eq 'HASH') { + # Individual item is a single key/value hash + my ($key, $value) = %$tag; + $tags->{$key} = $value; + } else { + # Individual item is a string, default to boolean truth flag + $tags->{$tag} = 1; # default to 1 + } + } + $rJSON->tags( {%existingTags, %$tags }); + } + } +} + =head2 _test_mc Private sub. Triggered when a test spec requests "test_mc". @@ -370,6 +398,7 @@ sub _test_mc { testCount_ref => { type => SCALARREF }, args => { type => ARRAYREF }, name => 0, + setup => 1, }); # assemble the top-level ingredients.. @@ -377,6 +406,7 @@ sub _test_mc { my $surveyOrder = $opts{surveyOrder}; my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName}; my $args = $opts{args}; + my $setup = $opts{setup}; # the first item is the section/question my $variable = shift @$args; @@ -396,6 +426,9 @@ sub _test_mc { # Reset responses between sub-tests $rJSON->reset; + # Run setup (per-sub-test) + $self->_setup( { responseJSON => $rJSON, setup => $setup } ); + # Test runs from $variable $rJSON->nextResponse($index); @@ -465,7 +498,7 @@ sub _sequence { my $surveyOrder = $opts{surveyOrder}; my $surveyOrderIndexByVariableName = $opts{surveyOrderIndexByVariableName}; my $args = $opts{args}; - my $name = $opts{name}; + my $name = $opts{name} || 'Valid sequences'; my $testCount = ++${$opts{testCount_ref}}; # n.b. everything in %args assumed to be variable => spec @@ -513,7 +546,7 @@ sub _sequence { } } - return pass($testCount, "Valid sequences"); + return pass($testCount, $name || $name); } =head2 _recordResponses diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 321e286f3..1f6a3712e 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -21,7 +21,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 70; +plan tests => 79; my ( $s, $t1 ); @@ -47,9 +47,10 @@ $s->surveyJSON_newObject( [] ); # S2 $s->surveyJSON_newObject( [] ); # S3 $s->surveyJSON_newObject( [] ); # S4 $s->surveyJSON_newObject( [] ); # S5 +$s->surveyJSON_newObject( [] ); # S6 # Name the sections -for my $sIndex (0..5) { +for my $sIndex (0..6) { $s->surveyJSON_update( [$sIndex], { variable => "S$sIndex" } ); } @@ -61,6 +62,9 @@ $s->surveyJSON_newObject( [3] ); # S3Q0 $s->surveyJSON_newObject( [3] ); # S3Q1 $s->surveyJSON_newObject( [3] ); # S3Q2 $s->surveyJSON_newObject( [4] ); # S4Q0 +$s->surveyJSON_newObject( [5] ); # S5Q0 +$s->surveyJSON_newObject( [5] ); # S5Q1 +$s->surveyJSON_newObject( [5] ); # S5Q2 # Name the questions $s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } ); @@ -70,6 +74,9 @@ $s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } ); $s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } ); $s->surveyJSON_update( [ 3, 2 ], { variable => 'S3Q2' } ); $s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } ); +$s->surveyJSON_update( [ 5, 0 ], { variable => 'S5Q0' } ); +$s->surveyJSON_update( [ 5, 1 ], { variable => 'S5Q1' } ); +$s->surveyJSON_update( [ 5, 2 ], { variable => 'S5Q2' } ); # Set additional options.. $s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No @@ -87,20 +94,28 @@ for my $qIndex (0..2) { $s->surveyJSON_update( [ 4, 0 ], { questionType => 'Concern' } ); +$s->surveyJSON_update( [ 5, 0 ], { questionType => 'Slider', required => 1 } ); +$s->surveyJSON_update( [ 5, 1 ], { questionType => 'Text', required => 1 } ); +$s->surveyJSON_update( [ 5, 2 ], { questionType => 'Number', required => 1 } ); + # And finally, persist the changes.. $s->persistSurveyJSON; cmp_deeply( - $s->responseJSON->surveyOrder, [ - [ 0, 0, [ 0, 1 ] ], # S0Q0 - [ 1, 0, [ 0, 1 ] ], # S1Q0 - [ 2, 0, [] ], # S2Q0 - [ 3, 0, [ 0, 1 ] ], # S3Q0 - [ 3, 1, [ 0, 1 ] ], # S3Q1 - [ 3, 2, [ 0, 1 ] ], # S3Q2 - [ 4, 0, [ 0 .. 10 ] ], # S4Q0 - [ 5 ], # S5 - ], 'surveyOrder is correct' + $s->responseJSON->surveyOrder, + [ [ 0, 0, [ 0, 1 ] ], # S0Q0 + [ 1, 0, [ 0, 1 ] ], # S1Q0 + [ 2, 0, [] ], # S2Q0 + [ 3, 0, [ 0, 1 ] ], # S3Q0 + [ 3, 1, [ 0, 1 ] ], # S3Q1 + [ 3, 2, [ 0, 1 ] ], # S3Q2 + [ 4, 0, [ 0 .. 10 ] ], # S4Q0 + [ 5, 0, [0] ], # S5Q0 + [ 5, 1, [0] ], # S5Q0 + [ 5, 2, [0] ], # S5Q0 + [6], # S6 + ], + 'surveyOrder is correct' ); cmp_deeply( $s->responseJSON->surveyOrderIndexByVariableName, @@ -118,6 +133,10 @@ cmp_deeply( 'S4' => 6, 'S4Q0' => 6, 'S5' => 7, + 'S5Q0' => 7, + 'S5Q1' => 8, + 'S5Q2' => 9, + 'S6' => 10, }, 'surveyOrderIndexByVariableName correct' ); @@ -376,6 +395,24 @@ END_TAP # Use the setup option $spec = < < < < <