traitement des erreurs et poursuite des tests...

test des clones...

1 files changed, 298 insertions, 97 deletions

diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl
index 5d92eac..561777f 100644
--- a/Perl/t/test-no-crash.pl
+++ b/Perl/t/test-no-crash.pl
@@ -1,14 +1,18 @@
 #!/usr/bin/perl -w
 # $Id$
-# This simple demo has been developped by C. Mertz <mertz@cena.fr>
+# This non-regression test has been developped by C. Mertz <mertz@cena.fr>
 
 use Tk;
 use Tk::Zinc;
 use Getopt::Long;
 use IO::Handle;    # for autoflushing the logs
+use Carp;
 
 use strict;
 
+use constant ERROR => '--an error--';
+
+
 unshift (@INC, "/usr/lib/perl5/Tk");  # for getting Tk some images;
 
 # les variables positionnées en fonction des options de la ligne de commande
@@ -66,44 +70,65 @@ my @itemtypes = qw(arc tabular track waypoint
 if ($opt_type) { @itemtypes = ($opt_type); }
 
 
+#### some global variables needed as attributes values
+my ($text1, $text2, $text3, $text4);
+my ($image1, $image2, $image3, $image4);
 
-$zinc->add('group', 1);
-$zinc->add('group', 1);
-$zinc->add('icon', 1);
-$zinc->add('map', 1);
-$zinc->add('reticle', 1);
-my $text1 = $zinc->add('text', 1,  -position => [300,120], -text => "hello world1");
-my $text2 = $zinc->add('text', 1,  -position => [350,170], -text => "hello world2");
-my $text3 = $zinc->add('text', 1,  -position => [400,220], -text => "hello world3");
-$zinc->add('window', 1);
-$zinc->add('track', 1, 5, -position => [100,20]);
-$zinc->add('waypoint', 1, 5, -position => [100,20]);
-$zinc->add('tabular', 1, 5, -position => [100,20]);
-$zinc->add('tabular', 1, 5, -position => [100,20]);
-$zinc->add('group', 1);
-$zinc->add('group', 1);
+&creating_items ("unused");
+
+sub creating_items {
+    # first removing all remaining items
+    foreach my $item (&test_eval (1, "find", 'all')) {
+	&test_eval (1, "remove", $item);
+    }
 
+
+    my $labelformat = "x82x60+0+0 x60a0^0^0 x32a0^0>1 a0a0>2>1 x32a0>3>1"; 
+    # and then creating items
+    &test_eval (1, "add", 'group', 1);
+    &test_eval (1, "add", 'group', 1);
+    &test_eval (1, "add", 'icon', 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");
+    $text3 = &test_eval (1, "add", 'text', 1,  -position => [400,220], -text => "hello world3");
+    &test_eval (1, "add", 'window', 1);
+#    &test_eval (1, "add", 'track', 1, 5, -position => [100,200]);
+    &test_eval (1, "add", 'track', 1, 5, -position => [100,200]);
+    &test_eval (1, "add", 'waypoint', 1, 5, -position => [200,100]);
+    &test_eval (1, "add", 'tabular', 1, 5, -position => [100,20]);
+    &test_eval (1, "add", 'group', 1);
+
+    &test_eval (1, "mapinfo", 'mapinfo1', 'create');
+    &test_eval (1, "mapinfo", 'mapinfo2', 'create');
+    &test_eval (1, "mapinfo", 'mapinfo3', 'create');
+    
 #$zinc->itemconfigure ('tabular', -labelformat => "200x10");
 #$zinc->update;
 
 
 
-$zinc->add('arc', 1, [10,10 , 50,50]);
-$zinc->add('bezier', 1, [10,10 , 50,50, 100,10, 10,200, 150,40]);
-$zinc->add('curve', 1, [30,0 , 150,10, 100,110, 10,100, 50,140]);
-$zinc->add('rectangle', 1, [400,400 , 450,220]);
-$zinc->add('triangles', 1, [200,200 , 300,200 , 300,300, 200,300],
- 	   -colors => ["blue:50", "red:20", "green:80"]);
+    &test_eval (1, "add", 'arc', 1, [10,10 , 50,50]);
+    &test_eval (1, "add", 'bezier', 1, [10,10 , 50,50, 100,10, 10,200, 150,40]);
+    &test_eval (1, "add", 'curve', 1, [30,0 , 150,10, 100,110, 10,100, 50,140]);
+    &test_eval (1, "add", 'rectangle', 1, [400,400 , 450,220]);
+    &test_eval (1, "add", 'triangles', 1, [200,200 , 300,200 , 300,300, 200,300],
+		-colors => ["blue:50", "red:20", "green:80"]);
+    
+    $image1 = $zinc->Photo(-file => Tk::findINC("icon.gif") );
+    $image2 = $zinc->Photo(-file => Tk::findINC("Xcamel.gif") );
+    $image3 = $zinc->Photo(-file => Tk::findINC("tranicon.gif") );
+    $image4 = $zinc->Photo(-file => Tk::findINC("anim.gif") );
 
-my $image1 = $zinc->Photo(-file => Tk::findINC("icon.gif") );
-my $image2 = $zinc->Photo(-file => Tk::findINC("Xcamel.gif") );
-my $image3 = $zinc->Photo(-file => Tk::findINC("tranicon.gif") );
-my $image4 = $zinc->Photo(-file => Tk::findINC("anim.gif") );
+    &creating_datas;  # some of the data are using items!
+}
 
 
 my %options;
 my %types;
 
+
 foreach my $itemType (@itemtypes) {
     my $anItem = $zinc->find('withtype', $itemType);
     if (!defined $anItem) { &log (-10, "no item $itemType\n"); next;};
@@ -115,25 +140,51 @@ foreach my $itemType (@itemtypes) {
     }
 }
 
+my %fieldOptions;
+
+{
+my $aTrack = $zinc->find('withtype', 'track');
+if (!defined $aTrack) { &log (-10, "no item track\n") }
+else {
+    my @fieldOptions = $zinc->itemconfigure($aTrack, 0);
+    for my $elem (@fieldOptions) {
+	my ($optionName, $optionType, $readOnly, $empty, $optionValue) = @$elem;
+	$fieldOptions{$optionName} = [$optionType, $readOnly, $empty, $optionValue];
+	$types{$optionType} = 1;
+    }
+}
+}
+
 foreach my $type (sort keys %types) {
 #    print "$type\n";
 }
 
+# a hash giving samples of valid data for attributes types
+my %typesValues;
 
-$zinc->mapinfo('mapinfo1', 'create');
-$zinc->mapinfo('mapinfo2', 'create');
-$zinc->mapinfo('mapinfo3', 'create');
+# the following hash associated to types valid value that should be all different from
+# default value and from value initiated when creating items (see up...)
+my %typesNonStandardValues;
+
+# a hash giving samples of NOT valid data for attributes types
+my %typesIllegalValues;
 
-my %typesValues =
+sub creating_datas {
+  %typesValues =
     ('justify' => ['left', 'right', 'center'],
      'alpha' => [0, 50, 100, 23],
      'anchor' => ['n', 's', 'e', 'w', 'nw', 'ne', 'sw', 'se', 'center'],
      'angle' => [0, 90, 180, 270, 360, 12, 93, 178, 272, 359],
-     'autoalignment' => ['lll', 'llr', 'llc', 'lrl', 'lrr', 'lrc', 'lcl', 'lcr', 'lcc',
-			 'rll', 'rlr', 'rlc', 'rrl', 'rrr', 'rrc', 'rcl', 'rcr', 'rcc',
-			 'cll', 'clr', 'clc', 'crl', 'crr', 'crc', 'ccl', 'ccr', 'ccc',
-			 '-',],
+#     'autoalignment' => ['lll', 'llr', 'llc', 'lrl', 'lrr', 'lrc', 'lcl', 'lcr', 'lcc',
+#			 'rll', 'rlr', 'rlc', 'rrl', 'rrr', 'rrc', 'rcl', 'rcr', 'rcc',
+#			 'cll', 'clr', 'clc', 'crl', 'crr', 'crc', 'ccl', 'ccr', 'ccc',
+#			 '-',],
+     'autojustify' => ['lll', 'llr', 'llc', 'lrl', 'lrr', 'lrc', 'lcl', 'lcr', 'lcc',
+		       'rll', 'rlr', 'rlc', 'rrl', 'rrr', 'rrc', 'rcl', 'rcr', 'rcc',
+		       'cll', 'clr', 'clc', 'crl', 'crr', 'crc', 'ccl', 'ccr', 'ccc',
+		       '-',],
      'boolean' => [0..1],
+     'border' => ['left', 'right', 'top', 'bottom', 'contour', 'oblique', 'counteroblique'], ## +combinations!
      'pattern' => ['AlphaStipple0', 'AlphaStipple3', 'AlphaStipple14', 'AlphaStipple11', 'AlphaStipple7'], ####?!
      'patterns' => [['AlphaStipple0', 'AlphaStipple3', 'AlphaStipple14', 'AlphaStipple11', 'AlphaStipple7'], ['AlphaStipple0']], ##TBC
      'capstyle' => ['butt', 'projecting', 'round'],
@@ -144,7 +195,7 @@ my %typesValues =
 		     ['blue:0', 'green:50', 'red:90'],
 		     ], ## TBC
      'dimension' => [0..5, 10, 50, 100, 0.0, 5.5, 100.5, 4.5],  ## and floats ?!
-     'edgelist' => ['left', 'right', 'top', 'bottom', 'contour', 'oblique', 'counteroblique'], ## +combinations!
+#     'edgelist' => ['left', 'right', 'top', 'bottom', 'contour', 'oblique', 'counteroblique'], ## +combinations!
      'font' => ['10x20', '6x10', '6x12', '6x13'],
      'image' => [$image1, $image2, $image3], ## TBC
      'integer' => [-10000, -100, -1, 0, 1, 10, 10000], ## pour quoi?
@@ -154,7 +205,8 @@ my %typesValues =
 		       "200x10", ## BUG BUG
 #		       "200x100 x100x20+0+0 x100x20+0+20 x200x40+100+20"
 		       ],
-     'leaderanchors' => ["%10x30", "%40x20", "%67x21" ], ## TBC! non exchaustif!! BUG non conforme à la doc
+     'leaderanchors' => ["%10x30", "|0|0", "%40x20", "|1|1", "|100|100", "%67x21" ], ## TBC! non exchaustif!! BUG non conforme à la doc
+     # illegal et fait planter: "%50" 
      'lineend' => [ [10,10,10], [10,100,10], [100,10,10], [10,10,100], [100,10,100] ],
      'lineshape' => ['straight', 'rightlightning', 'leftlightning', 'rightcorner', 'leftcorner', 'doublerightcorner', 'doubleleftcorner'],
      'linestyle' => ['dotted', 'simple', 'dashed', 'mixed', 'dotted'],
@@ -173,7 +225,7 @@ my %typesValues =
 
 # the following valid value associated to types should be all different from
 # default value and from value initiated when creating items (see up...)
-my %typesNonStandardValues = 
+   %typesNonStandardValues = 
     ('justify' => 'right',
      'alpha' => 50,
      'anchor' => 'w',
@@ -192,7 +244,7 @@ my %typesNonStandardValues =
      'item' => $text3,
      'joinstyle' => 'miter',
      'labelformat' => "200x30", ## BUG BUG
-     'leaderanchors' => "%10x60", ## BUG BUG
+     'leaderanchors' => "%10x45", ## BUG BUG
      'lineend' => [13,7,20],
      'lineshape' => 'rightlightning',
      'linestyle' => 'dotted',
@@ -207,7 +259,7 @@ my %typesNonStandardValues =
      'window' => undef, ### TBC
  );
     
-my %typesFalseValues =
+   %typesIllegalValues =
     ('alpha' => [0..100],
      'anchor' => ['n', 's', 'e', 'w'], ##TBC
      'angle' => [0..360],
@@ -215,11 +267,12 @@ my %typesFalseValues =
      'capstyle' => [],
      'dimension' => [0..100],
      'font' => ['10x20', '6x10', '6x12', '6x13'],
+     'leaderanchors' => ["%50"  ], ## TBC! non exchaustif!! BUG non
      'relief' => ['flat', 'groove', 'raised', 'ridge', 'sunken',
 		  'roundraised', 'roundsunken', 'roundgroove',
 		  'roundridge', 'sunkenrule', 'raisedrule'],
      );
-
+}
 
 $mw->Button(-text => "Test options",
 	    -command => sub {&test_attributes},
@@ -229,21 +282,90 @@ $mw->Button(-text => "Test cloning",
 	    -command => sub {&test_cloning},
 	    )->pack(-pady => 4);   
 
-    
+$mw->Button(-text => "Test fields attributes",
+	    -command => sub {&test_every_field_attributes},
+	    )->pack(-pady => 4);   
+
 ### print log information to the logfile
-### if $level is lower than opt_log alos print log on the stdout
+### if $level is <= than opt_log (def = 0) then print log on the stdout
+###  - a loglevel of -100 means an error to be loggued with %%% prefix
+###  - a loglevel of -10 means an error in the test (data missing?)
+###  - a loglevel of 0 means an message to be usually printed (aznd logged in any case)
+###  - a loglevel greater than 1 is for trace only
+
+
 sub log {
     my ($level, @strgs) = @_;
-    print @strgs if $level <= $opt_log ;
+    if ($level <= $opt_log) {
+	print "%%%% " if $level == -100;
+	print "%% " if $level == -10;
+	print @strgs;
+    }
+    print LOG "%%%% " if $level == -100;
+    print LOG "%% " if $level == -10;
     print LOG @strgs;
 }
 
+my %method_with_tagOrId =
+    ("anchorxy" => 1, "bbox" => 1, "bind" => 1, "chggroup" => 1,
+     "clone" => 1, "contour" => 1, "coords"=> 1, "cursor" => 1,
+     "dchars" => 1, "dtag" => 1, "focus" => 1, "gettags" => 1,
+     "group" => 1, # blabla... to complete
+     "itemcget" => 1, "itemconfigure" => 1, # blabla... to complete
+     "remove" => 1,
+     );
+
+
+###  - a loglevel of -100 means an error to be loggued with %%% prefix
+###  - a loglevel of -10 means an error in the test (data missing?)
+###  - a loglevel of of 0 or greater is for trace only if an error occured
+sub test_eval {
+    my ($loglevel, $method, @args) = @_;
+
+    my @strs;
+    my $start_index = 0;
+    if (scalar @args) {
+	if ($method_with_tagOrId{$method} and $args[0] =~ /\d+/) {
+	    my $item = $args[0];
+	    @strs = $item . " (" . $zinc->type($item) . ") ";
+	    $start_index = 1;
+	}
+	foreach my $arg (@args[$start_index..$#args]) {
+	    push @strs, &printable (ref($arg), $arg);
+	}
+    }
+    my $string2log = "\$zinc->$method (" . join (", ", @strs) . ")\n";
+    
+    &log ($loglevel, $string2log);
+    
+    my (@res, $res);
+    if (wantarray()) { @res = eval { $zinc->$method (@args) } ; }
+    else { $res = eval { $zinc->$method (@args) } ; }
+
+    if ($@) { # in case of error, logging!
+	&log (-100, "Error while evaluating: $string2log");
+	&log (-100, $@);
+	my $msgl = &Carp::longmess;
+	my ($msg2) = $msgl =~ /.*?( at .*)/s ; 
+	&log (-100, "\t$msg2");
+	return (ERROR);
+    }
+    else {
+	if (wantarray()) {
+	    return @res;
+	}
+	else {
+	    return $res;
+	}
+    }
+}
+
 sub test_attributes {
     foreach my $type (@itemtypes) {
 	my @items = $zinc->find('withtype', $type);
-	&log (0, "---------testing ", (1+$#items), " ",$type,"(s) ----------------\n");
+	&log (0, "--------- Testing ", (1+$#items), " ",$type," ----------------\n");
 	if ($#items == -1) {
-	    &log (-100, "*** no such item: $type\n");
+	    &log (-100, "No such item: $type\n");
 	    next;
 	}
 	my %theoptions = %{$options{$type}};
@@ -254,7 +376,7 @@ sub test_attributes {
 	    my @boolean_attributes;
 	    my %boolean_attributes;
 	    foreach my $option (sort keys %theoptions) {
-		my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$type}{$option}};
+		my ($optionType, $readOnly, $empty, $optionValue) = @{$theoptions{$option}};
 		if ($optionType eq 'boolean') {
 		    next if $option eq -composerotation;
 		    next if $option eq -composescale;
@@ -266,7 +388,6 @@ sub test_attributes {
 		    $boolean_attributes{$option}=1;
 		}
 	    }
-#	    print $type, "(id $item) : ", ((2**(1+$#boolean_attributes)) , " Combinations (", join (', ' , @boolean_attributes),")\n");
 	    &log (0, $type, "(id $item) : ", ((2**(1+$#boolean_attributes)) , " Combinations (", join (', ' , @boolean_attributes),")\n"));
 	    foreach my $i (0 .. (2**(1+$#boolean_attributes) -1) ) {
 		my $format = "%0" . ($#{boolean_attributes} +1) . "b";
@@ -274,21 +395,20 @@ sub test_attributes {
 		&log (0, $i, "/", (2**(1+$#boolean_attributes)), "  $binary\n");
 		my @binary = split (//,$binary);
 		foreach my $j (0 .. $#boolean_attributes) {
-		    $zinc->itemconfigure( $item, $boolean_attributes[$j] => $binary[$j] );
-#		    print "setting $type ($item) ", $boolean_attributes[$j], " to ", $binary[$j], "\n";
-		    &log (0, "setting $type ($item) ", $boolean_attributes[$j], " to ", $binary[$j], "\n");
+		    &test_eval (0, "itemconfigure", $item, $boolean_attributes[$j] => $binary[$j] );
+#		    &log (0, "setting $type ($item) ", $boolean_attributes[$j], " to ", $binary[$j], "\n");
 		}
 		foreach my $option (sort keys %theoptions) {
 		    next if ($option eq -numfields); # BUG? makes the appli stop
 		    next if ($option eq "-clip" and $type = "group"); # BUG? This test cannot be random clipping item must belong to the group
 		    next if ($boolean_attributes{$option}); # skipping boolean attributes which are exhaustively tested
 
-		    my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$type}{$option}};
+		    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;}
+		    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;}
+		    if (!@values) {&log (-100, "No values for type $optionType (option $option)\n");next;}
 			
 
 		    my $valueRef = ref ($values[0]);
@@ -302,12 +422,9 @@ sub test_attributes {
 			@previous_val = $zinc->itemcget($item, $option);
 		    }
 		    &log (1, "\$zinc->itemconfigure($item ($type), $option => ",&printables ($valueRef,@values),"\n");
-#			if ($opt_log == 1);
 		    foreach my $value (@values) {
-			my $log_lev = 2;
-			$log_lev = 0 if ($opt_trace eq $option || $opt_trace eq $optionType ) ;
+			my $log_lev = ($opt_trace eq $option || $opt_trace eq $optionType ) ? 0 : 2 ;
 			&log ( $log_lev, "\$zinc->itemconfigure($item ($type), $option => $value)\n");
-#			    if ($opt_log > 1 || $opt_trace eq $option || $opt_trace eq $optionType );
 			$zinc->itemconfigure($item, $option => $value);
 			$zinc->update;
 			$zinc->after(10);
@@ -321,11 +438,10 @@ sub test_attributes {
 		    }
 		    
 		}
-#		print "end of sub_test_option\n";
 	    }
 	}
     }
-    &log (0, "End of test_option\n");
+    &log (0, "End of test_attributes\n");
 }
 
 
@@ -338,23 +454,24 @@ sub test_attributes {
 # test4: tester qu'en clonant on obtient bien une copie de tous les attributs
 
 sub test_cloning {
+    &creating_items;
     foreach my $type (@itemtypes) {
 	my $item = $zinc->find('withtype', $type);
-	&log (0, "---------cloning and testing item ",$type,"(s) ----------------\n");
-	if (!defined $item) { &log (-100, "*** no such item: $type\n"); next;};
-	my $clone = $zinc->clone($item);
+	&log (0, "--------- Cloning and testing item ",$type," ----------------\n");
+	if (!defined $item) { &log (-10, "No such item: $type\n"); next;};
+	my $clone = &test_eval(1, "clone", $item);
 
-	&log (0, "---- modifying the clone\n");
+	&log (0, "---- Modifying the clone $clone\n");
 	&test_a_clone ($type, $item, $clone);
 	&test_enclosed_overlapping_closest($type, 'original', $item, $zinc->bbox ($item));
 	&test_enclosed_overlapping_closest($type, 'clone', $clone, $zinc->bbox ($clone));
-	&log (0, "---- modifying the original\n");
+	&log (0, "---- Modifying the original\n");
 	&test_a_clone ($type, $clone, $item);
 	&test_enclosed_overlapping_closest($type, 'original', $item, $zinc->bbox ($item));
 	&test_enclosed_overlapping_closest($type, 'clone', $clone, $zinc->bbox ($clone));
-	$zinc->remove($item);
+	&test_eval (1, "remove", $item);
 	&test_every_attributes_once($type,$clone);
-	$zinc->remove($clone);
+	&test_eval (1, "remove", $clone);
     }
     # tester le find enclosed / overlapping avec un rectangle un peu plus grand que la bbox
     # tester le closest avec le centre de la bbox
@@ -384,27 +501,29 @@ sub test_cloning {
 sub test_enclosed_overlapping_closest {
     my ($type, $clone_or_original, $item, @bbox) = @_;
     if ($#bbox == -1) {
-	&log(-100, "*** undef bbox of a $type ($clone_or_original)\n");
+	&log(-100, "Undef bbox of a $type ($clone_or_original)\n");
     }
     else {
 	@bbox = ( $bbox[0]-10, $bbox[1]-10, $bbox[2]+10, $bbox[3]+10 );
-	my @items = $zinc->find ('enclosed', @bbox);
+	my @items = &test_eval (1, "find", 'enclosed', @bbox);
 	goto TESTOVERLAPPING if ($item eq '');
 	foreach my $i (@items) {
 	    goto TESTOVERLAPPING if ($i eq $item); # the item is included!
 	}
-	&log(-100, "*** the $type ($clone_or_original) is not enclosed in its bbox!\n");
+	&log(-100, "The $type ($clone_or_original) is not enclosed in its bbox!\n");
   TESTOVERLAPPING:
-	@items = $zinc->find ('overlapping', @bbox);
+#	@items = $zinc->find ('overlapping', @bbox);
+	@items = &test_eval (1, "find", 'overlapping', @bbox);
 	goto TESTCLOSEST if ($item eq '');
 	foreach my $i (@items) {
 	    goto TESTCLOSEST if ($i eq $item);
 	}
-	&log(-100, "*** the $type ($clone_or_original) is not overlapping its bbox!\n");
+	&log(-100, "The $type ($clone_or_original) is not overlapping its bbox!\n");
   TESTCLOSEST:
 	my $x = ($bbox[0] + $bbox[2] )/2;
 	my $y = ($bbox[1] + $bbox[3] )/2;
-	my $closest = $zinc->find ('closest', $x,$y);
+#	my $closest = $zinc->find ('closest', $x,$y);
+	my $closest = &test_eval (1, "find", 'closest', $x,$y);
     }
 }
 
@@ -414,10 +533,10 @@ sub test_a_clone {
     foreach my $option (sort keys %theoptions) {
 	next if ($option eq -numfields); # BUG? makes the appli stop
 	next if ($option eq "-clip" and $type = "group"); # BUG? This test cannot be random. Clipping item must belong to the group
-	my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$type}{$option}};
+	my ($optionType, $readOnly, $empty, $optionValue) = @{$theoptions{$option}};
 	my $value = $typesNonStandardValues{$optionType};
 	if ($optionType ne 'boolean' && !defined $value) {
-	    &log (-100, "*** no value for type $optionType (option $option)\n");
+	    &log (-100, "No value for type $optionType (option $option)\n");
 	    next;
 	}
 	
@@ -427,34 +546,32 @@ sub test_a_clone {
 	
 	# memoryzing previous value of the clone 
 	if ($valueRef eq '') {
-	    $previous_val = $zinc->itemcget($clone, $option);
+	    $previous_val = &test_eval (2, "itemcget", $clone, $option);
 	}
 	else {
-	    @previous_val = $zinc->itemcget($clone, $option);
+	    @previous_val = &test_eval (2, "itemcget", $clone, $option);
 	}
 
 	# in the case of boolean, we must always take the not value:
 	if ($optionType eq 'boolean') { $value = !$previous_val }
 	
-	my $log_lev = 2;
-	$log_lev = 0 if ($opt_trace eq $option || $opt_trace eq $optionType ) ;
-	&log ($log_lev, "\$zinc->itemconfigure(clone $clone of $original ($type), $option => ". &printable ($valueRef, $value) . "\n");
-	$zinc->itemconfigure($clone, $option => $value);
+	my $log_lev = ($opt_trace eq $option || $opt_trace eq $optionType) ? 0 : 2 ;
+	&test_eval ($log_lev, "itemconfigure", $clone, $option => $value);
 	$zinc->update;
 
 	if ($valueRef eq 'ARRAY') {  # the value is a list
-	    my @original_value = $zinc->itemcget($original, $option);
-	    my @clone_value = $zinc->itemcget($clone, $option);
+	    my @original_value = &test_eval (2, "itemcget", $original, $option);
+	    my @clone_value = &test_eval (1, "itemcget", $clone, $option);
 	    if ( &equal_arrays (\@original_value, \@clone_value) ) {
-		&log (-100, "*** Cloned $type gets the same $option (type $optionType) ". &printable($valueRef, \@original_value) . "\n");
+		&log (-100, "Cloned $type gets the same $option (type $optionType) ". &printable($valueRef, \@original_value) . "\n");
 	    }
 	}
 	else {  # the value is either a scalar or a class instance
-	    my $original_value = $zinc->itemcget($original, $option);
-	    my $clone_value = $zinc->itemcget($clone, $option);
+	    my $original_value = &test_eval (2, "itemcget", $original, $option);
+	    my $clone_value = &test_eval (2, "itemcget", $clone, $option);
 	    if (defined $original_value && $original_value eq $clone_value) {
 #		print "ORIGIN = ",$original_value, " $original_value CLONE = ",$clone_value,"\n";
-		&log (-100, "*** Cloned $type gets the same $option (type $optionType) " .
+		&log (-100, "Cloned $type gets the same $option (type $optionType) " .
 		      "(original=cloned: " . &printable($valueRef,$original_value) .
 		      "?=" . &printable($valueRef,$previous_val) .
 		      " :previous)\n");
@@ -463,10 +580,10 @@ sub test_a_clone {
 	
 	# setting back the previous value
 	if ($valueRef eq '') {
-	    $zinc->itemconfigure($clone, $option => $previous_val);
+	    &test_eval (1, "itemconfigure", $clone, $option => $previous_val);
 	}
 	else {
-	    $zinc->itemconfigure($clone, $option => \@previous_val);
+	    &test_eval (1, "itemconfigure", $clone, $option => \@previous_val);
 	}
 	
     }
@@ -478,27 +595,110 @@ sub test_every_attributes_once {
     foreach my $option (sort keys %theoptions) {
 	next if ($option eq -numfields); # BUG? makes the appli stop
 	next if ($option eq "-clip" and $type = "group"); # BUG? This test cannot be random. Clipping item must belong to the group
-	my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$type}{$option}};
+	my ($optionType, $readOnly, $empty, $optionValue) = @{$theoptions{$option}};
 	my $value = $typesNonStandardValues{$optionType};
 	if ($optionType ne 'boolean' && !defined $value) {
-	    &log (-100, "*** no value for type $optionType (option $option)\n");
+	    &log (-100, "No value for type $optionType (option $option)\n");
 	    next;
 	}
 	# in the case of boolean, we must always take the not value:
 	if ($optionType eq 'boolean') { $value = !$zinc->itemcget($item, $option) }
 	
-	my $log_lev = 2;
-	$log_lev = 0 if ($opt_trace eq $option || $opt_trace eq $optionType ) ;
+	my $log_lev = ($opt_trace eq $option || $opt_trace eq $optionType) ? 0 : 2 ;
 	&log ($log_lev, "\$zinc->itemconfigure($item ($type), $option => ". &printable (ref($value), $value) . "\n");
-	$zinc->itemconfigure($item, $option => $value);
+	&test_eval (1, "itemconfigure", $item, $option => $value);
 	$zinc->update;
     }
-}
+} # end test_every_attributes_once
 
+
+sub test_every_field_attributes {
+    foreach my $type qw(waypoint track tabular) {
+	my %theoptions = %fieldOptions;
+	my @items = $zinc->find('withtype', $type);
+	&log (0, "--------- Testing fields of ", (1+$#items), " ",$type,"(s) ----------------\n");
+	if ($#items == -1) {
+	    &log (-100, "No such item: $type\n");
+	    next;
+	}
+	foreach my $item (@items) {
+	    ## il faudrait tester les options selon un ordre défini à l'avance
+	    ## en passant par plusieurs occurences pour les options et en forçant
+	    ## certaines valeurs, par exemple les valeurs booléennees... (visible/sensible/filled)
+	    my @boolean_attributes;
+	    my %boolean_attributes;
+	    foreach my $option (sort keys %theoptions) {
+		my ($optionType, $readOnly, $empty, $optionValue) = @{$theoptions{$option}};
+		if ($optionType eq 'boolean') {
+#		    next if $option =~ /-\w+sensitive/ ;   # to get rid of many track options!
+#		    next if $option =~ /-filled\w+/ ;      # to get rid of many track options!
+#		    next if $option =~ /-speed\w+/ ;      # to get rid of many track options!
+#		    next if $option =~ /-\w+history/ ;      # to get rid of many track options!
+		    push @boolean_attributes, $option;
+		    $boolean_attributes{$option}=1;
+		}
+	    }
+	    &log (0, $type, "(id $item) : ", ((2**(1+$#boolean_attributes)) , " Combinations (", join (', ' , @boolean_attributes),")\n"));
+	    foreach my $i (0 .. (2**(1+$#boolean_attributes) -1) ) {
+		my $format = "%0" . ($#{boolean_attributes} +1) . "b";
+		my $binary = sprintf ($format,$i);
+		&log (0, $i, "/", (2**(1+$#boolean_attributes)), "  $binary\n");
+		my @binary = split (//,$binary);
+		foreach my $j (0 .. $#boolean_attributes) {
+		    &log (0, "setting $type ($item) field 0..",$zinc->itemcget($item, -numfields)-1,  " ", $boolean_attributes[$j], " to ", $binary[$j], "\n");
+		    foreach my $field (0 .. $zinc->itemcget($item, -numfields)-1 ) {
+			&test_eval (1, "itemconfigure", $item, $field, $boolean_attributes[$j] => $binary[$j] );
+		    }
+		}
+		foreach my $field (0 .. $zinc->itemcget($item, -numfields)-1 ) {
+		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 $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);
+		    }
+		    
+		    }}
+	    }
+	}
+    }
+    &log (0, "End of test_every_field_attributes\n");
+} # end test_every_field_attributes
+    
 sub printable {
     my ($ref, $value) = @_;
     if ($ref eq 'ARRAY') {
-	return ("[ " . join ( ', ', @{$value} ) . " ]");
+	return ("[" . join ( ', ', @{$value} ) . "]");
     }
     else {  # scalar or class instance
 	if (defined $value) {
@@ -508,7 +708,7 @@ sub printable {
 	    return "undef";
 	}
     }
-}
+} # end printable
 
 sub printables {
     my ($ref, @values) = @_;
@@ -541,6 +741,7 @@ sub 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
 
-#&test_attributes; # on peut configurer toutes les attributs
+&test_every_field_attributes;
+&test_attributes; # on peut configurer toutes les attributs
 &test_cloning; # le clonage fonctionne correctement !
 MainLoop();