aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Perl/t/test-no-crash.pl164
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();