Fixed bug where ResponseJSON was not properly resetting between

tests. Refactored out reset() sub to make it easy for people to
achieve reliable resetting of rJSON objects.
This commit is contained in:
Patrick Donelan 2009-05-21 08:21:17 +00:00
parent 206a45e7c2
commit 8baf09948e
3 changed files with 71 additions and 29 deletions

View file

@ -78,21 +78,35 @@ sub new {
my $self = {
_survey => $survey,
_session => $survey->session,
_response => {
# Response hash defaults..
responses => {},
lastResponse => -1,
questionsAnswered => 0,
startTime => time(),
surveyOrder => undef,
tags => {},
# And then jsonData overrides
%{$jsonData},
}
# _response property set by call to reset()
};
bless $self, $class;
$self->reset($jsonData);
}
=head2 reset
Reset all response data in this object (e.g. re-init the _response property)
=cut
sub reset {
my $self = shift;
my ($data) = validate_pos(@_, { type => HASHREF, default => {} } );
$self->{_response} = {
# Response hash defaults..
responses => {},
lastResponse => -1,
questionsAnswered => 0,
startTime => time(),
surveyOrder => undef,
tags => {},
# And then data overrides
%{$data},
};
return $self;
}
#----------------------------------------------------------------------------

View file

@ -152,8 +152,7 @@ sub run {
my $testCount = 0;
my @tap;
for my $item (@$spec) {
$self->_resetResponses($rJSON);
$rJSON->lastResponse(-1);
$rJSON->reset;
my $name = $item->{name};
my $args;
if ($args = $item->{test} ) {
@ -196,18 +195,6 @@ sub run {
return { tap => "$tap" };
}
=head2 _resetResponses
Private convenience sub to carry out the task of resetting a response between tests
=cut
sub _resetResponses {
my ($self, $rJSON) = @_;
$rJSON->responses( {} );
$rJSON->lastResponse(-1);
}
=head2 _test
Private sub. Triggered when a test spec requests "test".
@ -313,7 +300,6 @@ sub _test {
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 {
@ -408,7 +394,7 @@ sub _test_mc {
for my $spec (@specs) {
# Reset responses between sub-tests
$self->_resetResponses($rJSON);
$rJSON->reset;
# Test runs from $variable
$rJSON->nextResponse($index);

View file

@ -21,7 +21,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
plan tests => 67;
plan tests => 70;
my ( $s, $t1 );
@ -392,6 +392,48 @@ try_it( $t1, $spec, { tap => <<END_TAP } );
ok 1 - Checking tagged on page containing Section S1 Question S1Q0
END_TAP
# Check that the tags disappear between tests
$spec = <<END_SPEC;
[
{
"test" : {
"S1Q0" : "n", # sets a tag of its own
"setup" : { tag: [ "my test tag", { "my data tag": 1.5 } ] },
"page" : { S0Q0: "y" }, # make sure this doesn't get overwritten
"tagged" : [ 'tagged at S0Q0', { 'tagged at S1Q0' : 999 }, "my test tag", { "my data tag": 1.5 } ],
}
},
{
"test" : {
"S1Q0" : "y",
"tagged" : [ 'tagged at S0Q0'],
}
},
{
"test" : {
"S1Q0" : "y",
"tagged" : [ 'tagged at S1Q0',],
}
},
{
"test" : {
"S1Q0" : "y",
"tagged" : [ "my data tag" ],
}
},
]
END_SPEC
try_it( $t1, $spec, { tap => <<END_TAP, fail => 1 } );
1..4
ok 1 - Checking tagged on page containing Section S1 Question S1Q0
not ok 2 - Checking tagged on page containing Section S1 Question S1Q0
# Tag not found: tagged at S0Q0
not ok 3 - Checking tagged on page containing Section S1 Question S1Q0
# Tag not found: tagged at S1Q0
not ok 4 - Checking tagged on page containing Section S1 Question S1Q0
# Tag not found: my data tag
END_TAP
#########
# test_mc
#########