aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Perl/t/test-no-crash.pl34
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");