- am�lioration des messages en cas d'erreur pendant le cloning

1 files changed, 34 insertions, 11 deletions

diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl
index 2a8aed9..0399778 100644
--- a/Perl/t/test-no-crash.pl
+++ b/Perl/t/test-no-crash.pl
@@ -40,13 +40,14 @@ if ( open LOG, "no-crash.log" ) {
 }
 
 open LOG,">no-crash.log";
+autoflush LOG 1;
 
-&log (0, "testing Zinc-perl Version=" . $Tk::Zinc::VERSION . "\n");
 
-autoflush LOG 1;
 
 my $mw = MainWindow->new();
 
+&log (0, "testing Zinc-perl Version=" . $Tk::Zinc::VERSION . " - ", $mw->zinc(), "\n");
+
 # The explanation displayed when running this demo
 my $label=$mw->Label(-text => "This is a non-regression test, testing that
 zinc is not core-dumping!",
@@ -125,7 +126,28 @@ sub creating_items {
     $image4 = $zinc->Photo(-file => Tk::findINC("anim.gif") );
 
     &creating_datas;  # some of the data are using items!
-}
+} # end creating_items
+
+# verifies that we create an item of every existing type
+sub verifying_item_completion {
+    my @all_types = $zinc->add();  ## this use of add is not documented yet XXX!
+    my @all_items = $zinc->find ('withtag', 'all');
+    my %created_item_types;
+    foreach my $item (@all_items) {
+	$created_item_types{$zinc->type($item)} = 1;
+    }
+    foreach my $type (@all_types) {
+	if (defined $created_item_types{$type}) {
+	    delete $created_item_types{$type};
+	}
+	else {
+	    &log(-100, "item type \"type\" which exist in Zinc is not tested!\n");
+	}
+    }
+    foreach my $type (sort keys %created_item_types) {
+	&log(-100, "This tested item type \"$type\" is supposed not to exist in Zinc!\n");
+    }
+} # end verifying_item_completion
 
 # verifies that we create an item of every existing type
 sub verifying_item_completion {
@@ -194,7 +216,6 @@ my %typesNonStandardValues;
 my %typesIllegalValues;
 
 sub creating_datas {
-    
     %typesValues =
 	('alignment' => ['left', 'right', 'center'],
 	 'alpha' => [0, 50, 100, 23],
@@ -323,7 +344,7 @@ sub log {
     print LOG "%%%% " if $level == -100;
     print LOG "%% " if $level == -10;
     print LOG @strgs;
-}
+} # end log
 
 my %method_with_tagOrId =
     ("anchorxy" => 1, "bbox" => 1, "bind" => 1, "chggroup" => 1,
@@ -477,7 +498,7 @@ sub test_attributes {
 	}
     }
     &log (0, "End of test_attributes\n");
-}
+} # end test_attributes
 
 
 # test2: configurer les fields des track / waypoint / tabular
@@ -527,7 +548,7 @@ sub test_cloning {
     # tester le closest avec le centre de la bbox
      
     &log (0, "End of test_cloning\n");
-}
+} # end test_cloning
 
 ## teste le find enclosed / overlapping avec un rectangle un peu plus grand
 #  que la bbox donnée en paramètre.
@@ -560,7 +581,7 @@ sub test_enclosed_overlapping_closest {
 #	my $closest = $zinc->find ('closest', $x,$y);
 	my $closest = &test_eval (1, "find", 'closest', $x,$y);
     }
-}
+} # end test_enclosed_overlapping_closest
 
 sub test_a_clone {
     my ($type, $original, $clone) = @_;
@@ -622,7 +643,7 @@ sub test_a_clone {
 	}
 	
     }
-}
+} # end test_a_clone
 
 sub test_every_attributes_once {
     my ($type, $item) = @_;
@@ -757,7 +778,7 @@ sub printables {
 	}
 	return ("[ " . join ( ', ', @array) . " ]" );
     }
-}
+} # end printables
 
 
 ## return 1 if arrays have the same length and every items are eq 
@@ -772,7 +793,9 @@ sub equal_arrays {
 	return 0 if ($array1[$i] ne $array2[$i]);
     }
     return 1;
-}
+} # equal_arrays
+
+
 # #### &test_mapitems; # should be done before really testing map items attributes
 # #### &test_labelcontent; # should be done before really testing track/waypoint/tabular items attributes