diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 7cdfa1053..eeba78ccb 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -191,6 +191,16 @@ sub run { name => $name, } ); } + elsif (my $args = $item->{defined} ) { + push @tap, $self->_defined( { + responseJSON => $rJSON, + surveyOrder => $surveyOrder, + surveyOrderIndexByVariableName => $surveyOrderIndexByVariableName, + args => $args, + testCount_ref => \$testCount, + name => $name, + } ); + } else { push @tap, "Bail Out! Invalid test definition"; } @@ -284,7 +294,7 @@ sub _test { $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"); + return fail($testCount, "Invalid input for Year Month question type", "got: $spec\nExpected: YYYY Month"); } $responses->{"$address->[0]-$address->[1]-0"} = $spec; } @@ -529,14 +539,14 @@ sub _sequence { 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"); + 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"); + return fail($testCount, "$variable answer index $aNum score not in sequence", "got: $a->{value}\nExpected: $expect"); } } @@ -545,7 +555,57 @@ sub _sequence { } } - return pass($testCount, $name || $name); + return pass($testCount, $name); +} + +=head2 _defined + +Private sub. Triggered when a test spec requests "defined". + +=cut + +sub _defined { + 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} || 'Defined'; + my $testCount = ++${$opts{testCount_ref}}; + + # n.b. everything in %args assumed to be regex => spec + + while ( my ( $regex, $spec ) = each %$args ) { + my $r = qr/$regex/; + for my $question (@{$rJSON->survey->questions}) { + my $variable = $question->{variable}; + if ($variable =~ $r) { + # Currently only supports answer specs + my $answerSpec = $spec->{answer}; + my $aNum = 0; + for my $answer (@{$question->{answers}}) { + $aNum++; + for my $property (@$answerSpec) { + if (!defined $answer->{$property} || $answer->{$property} =~ m/^\s*$/) { + return fail($testCount, "$variable answer number $aNum property $property not defined", "got: '$answer->{$property}'"); + } + } + } + } + } + } + + return pass($testCount, $name); } =head2 _recordResponses diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index c15553123..d31d9c65a 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 => 79; +plan tests => 85; my ( $s, $t1 ); @@ -617,6 +617,38 @@ ok 1 - Valid sequences ok 2 - Say my name END_TAP +######### +# defined +######### +$spec = < < < 1 } ); +1..1 +not ok 1 - S1Q0 answer number 1 property recordedAnswer not defined +# got: '' +END_TAP + use TAP::Parser; sub try_it {