- on teste l'option -render pour s'assurer qu'on lui donne une valeur 0 1 ou 2

- ajout de l'option -tests pour connaitre la lsute des tests impl�ment�e et
  pour s�lectionner certains de ces tests uniquement.

1 files changed, 91 insertions, 7 deletions

diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl
index 9f6ff0c..38716f9 100644
--- a/Perl/t/test-no-crash.pl
+++ b/Perl/t/test-no-crash.pl
@@ -13,25 +13,55 @@ use strict;
 use constant ERROR => '--an error--';
 
 
+# the following list be coherent with the treatments done in the TEST section.
+my @testsList = (
+		 1 => 'test_mapitems (quick)',
+		 2 => 'test_every_field_attributes (long)',
+		 3 => 'test_attributes (medium)',
+		 4 => 'test_cloning (quick)',
+		 );
+my %testsHash;
+{ my @tests = @testsList;
+  while (@tests) {
+      my $num = shift (@tests);
+      my $comment = shift (@tests);
+      $testsHash{ $num } = $comment;
+  }
+}
+
 unshift (@INC, "/usr/lib/perl5/Tk");  # for getting Tk some images;
 
 # les variables positionnées en fonction des options de la ligne de commande
 my $opt_log = 0;
 my $opt_trace = "";
-my $opt_render = 0;
+my $opt_render = -1;
 my $opt_type = 0;
 my $outfile;
+my $opt_tests = "all";
 
 # 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,
+			   'render:s' => \$opt_render,
 			   'type=s' => \$opt_type,
 			   'help' => \&usage,
+			   'tests:s' => \$opt_tests,
 			   );
 
+# on teste la validité de l'option -render!
+if ($opt_render eq '') {
+    print "-render option have no value!\n";
+    &usage;
+}
+$opt_render = 1 if $opt_render == -1;
+unless ($opt_render==0 or $opt_render==1 or $opt_render==2) {
+    print "-render option value must be 0, 1 or 2!\n";
+    &usage;
+}
+
+
 $outfile = "no-crash-$Tk::Zinc::VERSION.log" if (!defined $outfile);
 
 if ( open LOG, "$outfile.prev" ) {
@@ -47,6 +77,12 @@ if ( open LOG, $outfile ) {
 open LOG,">$outfile";
 autoflush LOG 1;
 
+## must be done after the LOG file is open
+my @tests = &parseTestsOpt($opt_tests);
+my %tests;
+foreach my $t (@tests) {$tests{$t} = $t }
+
+
 sub usage {
     my ($text) = @_;
     print $text,"\n" if (defined $text);
@@ -58,9 +94,11 @@ sub usage {
     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 " -render 0|1|2   to select the render option of zinc\n";
+    print " -render 0|1|2   to select the render option of zinc (defaulted to 1)\n";
     print " -trace <an_item_option>  to better trace usage of an option\n";
     print " -type <a_zinc_item_type> to limits tests to this item type.\n";
+    print " -tests to get the list of available tests.\n";
+    print " -tests i,j,k... to define the list of tests to pass.\n";
     exit;
 }
 
@@ -845,17 +883,63 @@ sub test_mapitems {
 } # end test_mapitems
 
 
+sub parseTestsOpt {
+    my ($opt) = @_;
+    my @tests;
+    if ($opt eq '') {
+	print "Availables tests are:\n";
+	while (@testsList) {
+	    my $i = shift @testsList;
+	    my $comment = shift @testsList;
+	    print "\t$i => $comment\n";
+	}
+	exit;
+    } elsif ( $opt eq 'all' ) { ## default!
+	&log (0, "all tests will be passed through\n");
+	@tests = sort keys %testsHash;
+    } elsif ( $opt =~ /^\d+(,\d+)*$/ ) {
+	@tests = split (/,/ , $opt);
+	my $testnumb = (scalar @testsList) / 2;
+	foreach my $test (@tests) {
+	    die "tests num must not exceed $testnumb" if $test > $testnumb;
+	}
+	foreach my $test (@tests) {
+	    &log(0,  "Test to be done:$test => " . $testsHash{$test} . "\n");
+	}
+    } else {
+	print "bad -tests value. Must be a list of integer separated by ,\n";
+	&usage;
+    }
+    return @tests;
+} # end of parseTestsOpt
+
+
+
+# ---------- TEST ------------------
+# the following code must be coherent with the tests list described
+# on the very beginning of this file (see @testsList definition)
+
 &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
+
+if ($tests{1}) {
+    &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 tous les attributs
+if ($tests{2}) {
+    &test_every_field_attributes;
+}
+
+if ($tests{3}) {
+    &test_attributes; # on peut configurer tous les attributs
+}
 
 ### we SHOULD test that setting a bad type value ofr an option does not core dump zinc!
 
-&test_cloning; # we test that cloning items and modifiyng/removing them does not core dump
+if ($tests{4}) {
+    &test_cloning; # we test that cloning items and modifiyng/removing them does not core dump
+}
 
 # #### &test_fonts;  ## and specially big fonts with render = 1;
 # #### &test_path_tags;