diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 7f739831c..cd3abaef8 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -5,6 +5,7 @@ use base qw/WebGUI::Crud/; use WebGUI::International; use Test::Deep::NoTest; use JSON::PP; +use Data::Dumper; use Params::Validate qw(:all); Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); @@ -654,7 +655,7 @@ END_WHY } # Check tagged, if asked - + local $Data::Dumper::Sortkeys = 1; # 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; @@ -670,14 +671,13 @@ END_WHY return fail($testCount, $name, "Tag not found: $tagKey"); } my $currentTagValue = $currentTags->{$tagKey}; - + if (!eq_deeply($currentTagValue, $tagValue)) { - $self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue"); - return fail($testCount, $name, <session->log->debug("Incorrect tag value: $reason"); + return fail($testCount, $name, $reason); } } } @@ -688,12 +688,11 @@ END_WHY while (my ($tagKey, $tagValue) = each %$tagged) { my $currentTagValue = $currentTags->{$tagKey}; if (!eq_deeply($currentTagValue, $tagValue)) { - $self->session->log->debug("Incorrect tag value: $currentTagValue != $tagValue"); - return fail($testCount, $name, <session->log->debug("Incorrect tag value: $reason"); + return fail($testCount, $name, $reason); } } } @@ -717,6 +716,47 @@ END_WHY return pass($testCount, $name); } +=head2 get_differences + +Once L > 0.1 is in the WRE, this sub can be replaced with +L and L. + +=cut + +sub get_differences { + my ($a, $b) = @_; + + if (!ref $a && !ref $b) { + return <[$i], $b->[$i])) { + return "Array item at index $i differs\n" . get_differences($a->[$i], $b->[$i]); + } + } + } + if (ref $a eq 'HASH') { + for my $key (keys %$a, keys %$b) { + if (!eq_deeply($a->{$key}, $b->{$key})) { + return <{$key}' +expect : '$b->{$key}' +END_WHY + } + } + } + +} + sub pass { my ($testCount, $name, $extra) = @_; my $out = $name ? "ok $testCount - $name" : "ok $testCount"; diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index c76ec91a0..31faca5be 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 => 90; +plan tests => 94; my ( $s, $t1 ); @@ -705,6 +705,26 @@ sub try_it { } ok( !$parser->has_problems == !$opts->{fail}, ( $opts->{fail} ? "Fails" : "Passes" ) . ' as expected' ); } + +################### +# get_differences # +################### +is(WebGUI::Asset::Wobject::Survey::Test::get_differences('a', 'b'), < 1}, {a => 2}), <