From 9c2419ce803003dd83111f8676b432823fa8c714 Mon Sep 17 00:00:00 2001
From: mertz
Date: Wed, 12 Jun 2002 09:04:36 +0000
Subject: am�liorationsd de messages et de log

---
 Perl/t/test-no-crash.pl | 34 +++++++++++++++++++++++++---------
 1 file changed, 25 insertions(+), 9 deletions(-)

(limited to 'Perl/t')

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");
-- 
cgit v1.1