diff options
| -rw-r--r-- | Perl/t/test-no-crash.pl | 34 |
1 files changed, 25 insertions, 9 deletions
diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl index b5d8f59..2a8aed9 100644 --- a/Perl/t/test-no-crash.pl +++ b/Perl/t/test-no-crash.pl @@ -346,21 +346,37 @@ sub test_eval { if (scalar @args) { if ($method_with_tagOrId{$method} and $args[0] =~ /\d+/) { my $item = $args[0]; - @strs = $item . " (" . $zinc->type($item) . ") "; + @strs = $item . " (" . $zinc->type($item) . ")"; $start_index = 1; } foreach my $arg (@args[$start_index..$#args]) { push @strs, &printable (ref($arg), $arg); } } - my $string2log = "\$zinc->$method (" . join (", ", @strs) . ")\n"; - + my $string2log = "\$zinc->$method (" . join (", ", @strs) . ")"; + if ($method eq 'itemcget' or $method eq 'get') { + $string2log .= " := " ; + } + else { + $string2log .= "\n"; + } &log ($loglevel, $string2log); my (@res, $res); - if (wantarray()) { @res = eval { $zinc->$method (@args) } ; } - else { $res = eval { $zinc->$method (@args) } ; } - + if (wantarray()) { + @res = eval { $zinc->$method (@args) } ; + if ($method eq 'itemcget' or $method eq 'get') { + &log ($loglevel, "[" . join (", ", @res) . "]\n" ); + } + } + else { + $res = eval { $zinc->$method (@args) } ; + if ($method eq 'itemcget' or $method eq 'get') { + &log ($loglevel, (defined $res)? "$res\n" : "undef\n"); + } + } + + if ($@) { # in case of error, logging! &log (-100, "Error while evaluating: $string2log"); &log (-100, $@); @@ -377,7 +393,7 @@ sub test_eval { return $res; } } -} +} # end of test_eval sub test_attributes { foreach my $type (@itemtypes) { @@ -582,7 +598,7 @@ sub test_a_clone { my @original_value = &test_eval (2, "itemcget", $original, $option); my @clone_value = &test_eval (1, "itemcget", $clone, $option); if ( &equal_arrays (\@original_value, \@clone_value) ) { - &log (-100, "Cloned $type gets the same $option (type $optionType) ". &printable($valueRef, \@original_value) . "\n"); + &log (-100, "Modified cloned $type gets the same value for $option (type $optionType) ". &printable($valueRef, \@original_value) . "\n"); } } else { # the value is either a scalar or a class instance @@ -590,7 +606,7 @@ sub test_a_clone { my $clone_value = &test_eval (2, "itemcget", $clone, $option); if (defined $original_value && $original_value eq $clone_value) { # print "ORIGIN = ",$original_value, " $original_value CLONE = ",$clone_value,"\n"; - &log (-100, "Cloned $type gets the same $option (type $optionType) " . + &log (-100, "Modified cloned $type gets the same value for $option (type $optionType) " . "(original=cloned: " . &printable($valueRef,$original_value) . "?=" . &printable($valueRef,$previous_val) . " :previous)\n"); |