- ajout d'un help

- ajout d'une option out pour modifier le fichier de log
  par default le fichier de log est maintenant no-crash-<zincVersion>.log
- on teste un peu les maps infos
- suppression de code dupliqu� (verifying_item_completion)
- ajout d'un message de log au d�but et � la fin de chaque ensmeble de tests

1 files changed, 101 insertions, 63 deletions

diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl
index 0399778..6f60f21 100644
--- a/Perl/t/test-no-crash.pl
+++ b/Perl/t/test-no-crash.pl
@@ -20,29 +20,48 @@ my $opt_log = 0;
 my $opt_trace = "";
 my $opt_render = 0;
 my $opt_type = 0;
+my $outfile;
 
 # on récupère les options
 Getopt::Long::Configure('pass_through');
 my $optstatus = GetOptions('log=i' => \$opt_log,
+			   'out=s' => \$outfile,
 			   'trace=s' => \$opt_trace,
 			   'render=i' => \$opt_render,
 			   'type=s' => \$opt_type,
+			   'help' => \&usage,
 			   );
 
-if ( open LOG, "no-crash.log.prev" ) {
+$outfile = "no-crash-$Tk::Zinc::VERSION.log" if (!defined $outfile);
+
+if ( open LOG, "$outfile.prev" ) {
     close LOG;
-    unlink "no-crash.log.prev";
+    unlink "$outfile.prev";
 }
-if ( open LOG, "no-crash.log" ) {
+if ( open LOG, $outfile ) {
     close LOG;
-    link "no-crash.log", "no-crash.log.prev";
-    unlink "no-crash.log";
+    link $outfile, "$outfile.prev";
+    unlink "$outfile";
 }
 
-open LOG,">no-crash.log";
+open LOG,">$outfile";
 autoflush LOG 1;
 
-
+sub usage {
+    my ($text) = @_;
+    print $text,"\n" if (defined $text);
+    print "test-no-crash [options]\n";
+    print "       A non-regression test suite for zinc.\n";
+    print "       Some exhaustive test of zinc. Of course everything is not tested yet\n";
+    print " options are:\n";
+    print " -log <n>        trace level, defaulted to 0; higher level trace more infos\n";
+    print " -out filename   the log filename. defaulted to no-crash.log\n";
+    print "      NB: the previous log file is always renamed with a .prev suffix\n";
+    print " -trace <an_item_option>  to better trace usage of an option\n";
+    print " -render 0|1|2   to select the render option of zinc\n";
+    print " -help           to print this short help\n";
+    exit;
+}
 
 my $mw = MainWindow->new();
 
@@ -72,6 +91,7 @@ my @itemtypes = qw(arc tabular track waypoint
 
 if ($opt_type) { @itemtypes = ($opt_type); }
 
+foreach my $type (@itemtypes) { $itemtypes{$type}=1 }
 
 #### some global variables needed as attributes values
 my ($text1, $text2, $text3, $text4);
@@ -93,6 +113,7 @@ sub creating_items {
     &test_eval (1, "add", 'group', 1);
     &test_eval (1, "add", 'icon', 1);
     &test_eval (1, "add", 'map', 1);
+    &test_eval (1, "add", 'map', 1);
     &test_eval (1, "add", 'reticle', 1);
     $text1 = &test_eval (1, "add", 'text', 1,  -position => [300,120], -text => "hello world1");
     $text2 = &test_eval (1, "add", 'text', 1,  -position => [350,170], -text => "hello world2");
@@ -147,27 +168,6 @@ sub verifying_item_completion {
     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 {
-    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");
-    }
 }
 
 
@@ -417,6 +417,7 @@ sub test_eval {
 } # end of test_eval
 
 sub test_attributes {
+    &log (0, "---- End of test_attributes ----\n");
     foreach my $type (@itemtypes) {
 	my @items = $zinc->find('withtype', $type);
 	&log (0, "--------- Testing ", (1+$#items), " ",$type," ----------------\n");
@@ -497,7 +498,7 @@ sub test_attributes {
 	    }
 	}
     }
-    &log (0, "End of test_attributes\n");
+    &log (0, "---- End of test_attributes ----\n");
 } # end test_attributes
 
 
@@ -510,6 +511,7 @@ sub test_attributes {
 # test4: tester qu'en clonant on obtient bien une copie de tous les attributs
 
 sub test_cloning {
+    &log (0, "---- End of test_cloning ----\n");
     &creating_items;
     foreach my $type (@itemtypes) {
 	my $item = $zinc->find('withtype', $type);
@@ -547,7 +549,7 @@ sub test_cloning {
     # tester le find enclosed / overlapping avec un rectangle un peu plus grand que la bbox
     # tester le closest avec le centre de la bbox
      
-    &log (0, "End of test_cloning\n");
+    &log (0, "---- End of test_cloning ----\n");
 } # end test_cloning
 
 ## teste le find enclosed / overlapping avec un rectangle un peu plus grand
@@ -669,7 +671,9 @@ sub test_every_attributes_once {
 
 
 sub test_every_field_attributes {
+    &log (0, "---- Start of test_every_field_attributes ----\n");
     foreach my $type qw(waypoint track tabular) {
+	next unless $itemtypes{$type};
 	my %theoptions = %fieldOptions;
 	my @items = $zinc->find('withtype', $type);
 	&log (0, "--------- Testing fields of ", (1+$#items), " ",$type,"(s) ----------------\n");
@@ -707,48 +711,49 @@ sub test_every_field_attributes {
 		    }
 		}
 		foreach my $field (0 .. $zinc->itemcget($item, -numfields)-1 ) {
-		foreach my $option (sort keys %theoptions) {
+		    foreach my $option (sort keys %theoptions) {
 			next if ($boolean_attributes{$option}); # skipping boolean attributes which are exhaustively tested
-
+			
 			my ($optionType, $readOnly, $empty, $optionValue) = @{$theoptions{$option}};
-			my $typeValues = $typesValues{$optionType};
-		    if (!defined $typeValues) {&log (-100, "No values for type $optionType (option $option)\n");next;}
-		    my @values = @{$typeValues};
 
-		    if (!@values) {&log (-100, "No values for type $optionType (option $option)\n");next;}
+			my $typeValues = $typesValues{$optionType};
+			if (!defined $typeValues) {&log (-100, "No values for type $optionType (option $option)\n");next;}
+			my @values = @{$typeValues};
+			
+			if (!@values) {&log (-100, "No values for type $optionType (option $option)\n");next;}
 			
 
-		    my $valueRef = ref ($values[0]);
-		    my $previous_val;
-		    my @previous_val;
-
-		    if ($valueRef eq '') {
-			$previous_val = &test_eval (1, "itemcget", $item, $field, $option);
-		    }
-		    else {
-			@previous_val = &test_eval (1, "itemcget", $item, $field, $option);
-		    }
-		    &log (1, "\$zinc->itemconfigure($item ($type), $field, $option => ",&printables ($valueRef,@values),"\n");
-		    foreach my $value (@values) {
-			my $log_lev = ($opt_trace eq $option || $opt_trace eq $optionType) ? 0 : 2 ;
+			my $valueRef = ref ($values[0]);
+			my $previous_val;
+			my @previous_val;
+			
+			if ($valueRef eq '') {
+			    $previous_val = &test_eval (1, "itemcget", $item, $field, $option);
+			}
+			else {
+			    @previous_val = &test_eval (1, "itemcget", $item, $field, $option);
+			}
+			&log (1, "\$zinc->itemconfigure ($item ($type), $field, $option => ",&printables ($valueRef,@values),"\n");
+			foreach my $value (@values) {
+			    my $log_lev = ($opt_trace eq $option || $opt_trace eq $optionType) ? 0 : 2 ;
 #			&log ( $log_lev, "\$zinc->itemconfigure($item ($type), $field, $option => $value)\n");
-			&test_eval ($log_lev, "itemconfigure", $item, $field, $option => $value);
-			$zinc->update;
-			$zinc->after(10);
-		    }
-		    
-		    if ($valueRef eq '') {
-			&test_eval (1, "itemconfigure", $item, $field, $option => $previous_val);
-		    }
-		    else {
-			&test_eval (1, "itemconfigure", $item, $field, $option => \@previous_val);
-		    }
+			    &test_eval ($log_lev, "itemconfigure", $item, $field, $option => $value);
+			    $zinc->update;
+			    $zinc->after(10);
+			}
+			
+			if ($valueRef eq '') {
+			    &test_eval (1, "itemconfigure", $item, $field, $option => $previous_val);
+			}
+			else {
+			    &test_eval (1, "itemconfigure", $item, $field, $option => \@previous_val);
+			}
 		    
 		    }}
 	    }
 	}
     }
-    &log (0, "End of test_every_field_attributes\n");
+    &log (0, "---- End of test_every_field_attributes ----\n");
 } # end test_every_field_attributes
     
 sub printable {
@@ -796,15 +801,48 @@ sub equal_arrays {
 } # equal_arrays
 
 
-# #### &test_mapitems; # should be done before really testing map items attributes
+sub createMapInfo {
+    my ($name, $N,$deltaN, $radius, $centerX,$centerY) = @_;
+    &test_eval (1, "mapinfo", $name, 'create'); 
+
+    my @lineTypes=(qw/simple dashed dotted mixed marked/), 
+    my $deltaAngle=6.283/$N;
+    for (my $i = 0; $i < $N; $i++) {
+	my $x1 = $centerX + $radius * sin($i * $deltaAngle); 
+	my $y1 = $centerY + $radius * cos($i * $deltaAngle);
+	my $x2 = $centerX+ $radius * sin( ($i + $deltaN) * $deltaAngle); 
+	my $y2 = $centerY + $radius * cos( ($i + $deltaN)* $deltaAngle);
+	my $linetype = $lineTypes[$i%5];
+	$mw->mapinfo($name, 'add', 'line', $linetype, 1+$i%3, +$x1,$y1,$x2,$y2);
+    }
+} # end of createMapInfo
+
+sub test_mapitems {
+    my @mapinfoNames = @_;
+    &log (0, "---- Start of test_mapitems ----\n");
+    my @maps = $zinc->find('withtype', 'map');
+    my $counter=0;
+    foreach my $map (@maps) {
+	&test_eval (1, "itemconfigure", $map, -mapinfo => $mapinfoNames[$counter]);
+	if ($counter == $#maps) { $counter=0 }
+	$counter++;
+    }
+    &log (0, "---- End of test_mapitems ----\n");
+} # end test_mapitems
+
+
+&createMapInfo ('firstmap', 50, 20, 200, 200, 300);
+&createMapInfo ('secondmap', 12, 3, 200, 300, 50);
+&test_mapitems ('firstmap', 'secondmap'); # should be done before really testing map items attributes
 # #### &test_labelcontent; # should be done before really testing track/waypoint/tabular items attributes
 
 &test_every_field_attributes;
-&test_attributes; # on peut configurer toutes les attributs
+&test_attributes; # on peut configurer tous les attributs
 &test_cloning; # le clonage fonctionne correctement !
 
 # #### &test_path_tags;
 # #### &test_illegal_tags;
 
+&log (0, "---- End of test_no_crash ----\n");
 
 MainLoop();