diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/t/test-no-crash.pl | 98 |
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; |