initial release of a script testing automaticaly some

coherences between the refman.tex doc and some infos provided
by ZincTk directly

1 files changed, 219 insertions, 0 deletions

diff --git a/Perl/t/testdoc.pl b/Perl/t/testdoc.pl
new file mode 100644
index 0000000..5b82cbd
--- /dev/null
+++ b/Perl/t/testdoc.pl
@@ -0,0 +1,219 @@
+#!/usr/bin/perl -w
+# $Id$
+# This script verifies the conformity of the reference manual with
+# some types informations available inside ZincTk
+# It has been developped by C. Mertz <mertz@cena.fr>
+
+# limitations: this script makes some very strong assumptions
+#              on the latex Zinc reference manual formating!
+#              However if the formating changes, it should be
+#              simple to modify the &scanDoc function!
+
+use Tk;
+use Tk::Zinc;
+
+use strict;
+
+my $mw = MainWindow->new();
+
+# Creating the zinc widget
+# NB: this widget will not be displayed! It is only used for creating items
+# and getting some internal information about attributes/options and types.
+
+my $zinc = $mw->Zinc(-width => 1, -height => 1,);
+
+# Creating an instance of every item type
+my %itemtypes;
+
+# These Items have fields! So the number of fields must be given at creation time
+foreach my $type qw(tabular track waypoint) {
+    $itemtypes{$type} = $zinc->add($type, 1, 1);
+}
+
+# These items needs no specific initial values
+foreach my $type qw(group icon map reticle text window) {
+    $itemtypes{$type} = $zinc->add($type, 1);
+}
+
+# These items needs some coordinates at creation time
+# However curves and bezier usually needs more than 2 points.
+foreach my $type qw(arc bezier curve rectangle) {
+    $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1]);
+}
+# Triangles item needs at least 3 points for the coordinates 
+foreach my $type qw(triangles) {
+    $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1 , 2,2]);
+}
+
+
+my %zinc2doc;  # a hash recording every discrepency between attribute/option
+               # type between the doc and TkZinc
+my $current_item = 0;
+my $prev_attribute = 0;
+my %documentedOptions;
+my %itemAttributeDoc;
+
+&scanDoc ($ARGV[0]);
+
+sub scanDoc {
+    my ($filename) = @_;
+    open (DOC, $filename) or die "unable to open " . $filename . "\n";
+    while (<DOC>) {
+	if ( /^\\attribute\{(\w+)\}\{(\w+)\}\{(\w+)\}/ ) {
+	    $itemAttributeDoc{$1}{-$2}=$3;
+	    if ($1 eq $current_item) {
+		if ($2 lt $prev_attribute) {
+		    print "W: attributes $prev_attribute and $2 are not in alphabetical order for $1\n";
+		}
+	    }
+	    else {
+		$current_item = $1;
+		$prev_attribute = $2;
+	    }
+	}
+	elsif ( /^\\option\{(\w+)\}\{(\w+)\}\{(\w+)\}/ ) {
+	    # $1 = optionName
+	    # $2 = Database name
+	    # $3 = DatabaseClass
+	    $documentedOptions{-$1}=$3;
+	}
+    }
+}
+
+sub testAllOptions {
+    my @options = $zinc->configure();
+    my %options;
+    # we use this hashtable to check that all documented options
+    # are matching all existing options in TkZinc
+    
+    for my $elem (@options) {
+	my ($optionName, $optionDatabaseName, $optionClass, $default, $optionValue) = @$elem;
+	$options{$optionName} = [$optionClass, $default, "", $optionValue];
+    }
+
+    foreach my $optionName (sort keys %options) {
+	my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$optionName}};
+	# $empty is for provision by Zinc
+	
+	if (!defined $documentedOptions{$optionName}) {
+	    print "E: $optionName ($optionType) of Zinc IS NOT DOCUMENTED!\n";
+	    $options{$optionName} = undef;
+	    next;
+	}
+	if ($documentedOptions{$optionName} ne $optionType) {
+	    print "W: $optionName has type $optionType inside ZincTk and type $documentedOptions{$optionName} inside Doc\n";
+	    $zinc2doc{$optionType}=$documentedOptions{$optionName};
+	}
+#	$attributes{$attributeName} = undef;
+	$documentedOptions{$optionName} = undef;
+    }
+    
+    foreach my $unexistingDocOpt (sort keys %documentedOptions) {
+	if (defined $documentedOptions{$unexistingDocOpt}) {
+	    print "E: The Documented Option \"$unexistingDocOpt\" DOES NOT EXIST!\n";
+	}
+    }
+}
+
+sub testAllAttributes {
+    my ($type) = @_;
+
+    my %documentedAttributes = %{$itemAttributeDoc{$type}}; 
+    my @attributes = $zinc->itemconfigure($itemtypes{$type});
+
+    my %attributes;
+    # we use this hashtable to check that all documented attributes
+    # are matching all existing attributes in TkZinc
+    
+    foreach my $elem (@attributes) {
+	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
+	$attributes{$attributeName} = [$attributeType, $readOnly, $empty, $attributeValue];
+    }
+
+    foreach my $attributeName (keys %attributes) {
+	my ($attributeType, $readOnly, $empty, $attributeValue) = @{$attributes{$attributeName}};
+	# $empty is for provision by Zinc
+	
+	if (!defined $documentedAttributes{$attributeName}) {
+	    print "E: $attributeName ($attributeType) of item $type IS NOT DOCUMENTED!\n";
+	    $attributes{$attributeName} = undef;
+	    next;
+	}
+
+	if ($documentedAttributes{$attributeName} ne $attributeType) {
+	    print "W: $attributeName has type $attributeType inside ZincTk and type $documentedAttributes{$attributeName} inside Doc\n";
+	    $zinc2doc{$attributeType}=$documentedAttributes{$attributeName};
+	}
+#	$attributes{$attributeName} = undef;
+	$documentedAttributes{$attributeName} = undef;
+    }
+    
+    foreach my $unexistingDocAttr (sort keys %documentedAttributes) {
+	if (defined $documentedAttributes{$unexistingDocAttr}) {
+	    print "E: The Documented Attribute \"$unexistingDocAttr\" DOES NOT EXIST!\n";
+	}
+    }
+}
+
+
+sub testFieldAttributes {
+    my %documentedAttributes = %{$itemAttributeDoc{"field"}}; 
+    my @attributes = $zinc->itemconfigure($itemtypes{track},0);
+
+    my %attributes;
+    # we use this hashtable to check that all documented fields attributes
+    # are matching all existing fields attributes in TkZinc
+    
+    foreach my $elem (@attributes) {
+	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
+	$attributes{$attributeName} = [$attributeType, $readOnly, $empty, $attributeValue];
+    }
+
+    foreach my $attributeName (keys %attributes) {
+	my ($attributeType, $readOnly, $empty, $attributeValue) = @{$attributes{$attributeName}};
+	# $empty is for provision by Zinc
+	
+	if (!defined $documentedAttributes{$attributeName}) {
+	    print "E: $attributeName ($attributeType) of field IS NOT DOCUMENTED!\n";
+	    $attributes{$attributeName} = undef;
+	    next;
+	}
+
+	if ($documentedAttributes{$attributeName} ne $attributeType) {
+	    print "W: $attributeName of field has type $attributeType inside ZincTk and type $documentedAttributes{$attributeName} inside Doc\n";
+	    $zinc2doc{$attributeType}=$documentedAttributes{$attributeName};
+	}
+	$documentedAttributes{$attributeName} = undef;
+    }
+    
+    foreach my $unexistingDocAttr (sort keys %documentedAttributes) {
+	if (defined $documentedAttributes{$unexistingDocAttr}) {
+	    print "E: The Documented Field Attribute \"$unexistingDocAttr\" DOES NOT EXIST!\n";
+	}
+    }
+}
+
+
+
+print "--- TkZinc Options -----------------------------------------\n";
+&testAllOptions;
+print "--- Field Attributes ---------------------------------------\n";
+
+&testFieldAttributes;
+
+foreach my $type (sort keys %itemtypes) {
+    print "--- Item $type -------------------------------------------------\n";
+    &testAllAttributes($type);
+}
+
+print "------- Summary of type discrepencies between Doc and Zinc --------\n";
+printf "%15s |%15s\n", "zinctype","doctype";
+foreach my $typezinc (sort keys %zinc2doc) {
+    printf "%15s |%15s\n", $typezinc,$zinc2doc{$typezinc};
+}
+
+
+# MainLoop();
+
+
+1;