- on v�rifie en plus que tous les types d�crits dans la doc sont

  effectivement utilis�s.
- on v�rifie aussi qu'ils sont d�crits dans l'ordre alphab�tique

1 files changed, 68 insertions, 18 deletions

diff --git a/Perl/t/testdoc.pl b/Perl/t/testdoc.pl
index d054f45..264f716 100644
--- a/Perl/t/testdoc.pl
+++ b/Perl/t/testdoc.pl
@@ -8,12 +8,25 @@
 #              on the latex Zinc reference manual formating!
 #              However if the formating changes, it should be
 #              simple to modify the &scanDoc function!
+#
+# What this script currently does:
+#  - verifies that all Zinc options are documented
+#  - verifies that all items attributes (and their type) are documented
+#  - verifies that all field attributes options (and their type) are documented
+#  - verifies that all documented options and attributes really exists
+#  - verifies that all documented types are refered to in the doc
+# It also checks that options, attributes and types are documented in alphabetical order
+# It is heavily based on meta information available directly from zinc
+#
+# How to use it:
+#   testdoc.pl path_to_refman.tex
 
 use Tk;
 use Tk::Zinc;
 
 use strict;
 
+print "------- Testing conformity of refman.tex and meta-information from zinc Version $Tk::Zinc::VERSION\n";
 
 my $mw = MainWindow->new();
 
@@ -49,10 +62,10 @@ foreach my $type qw(triangles) {
 
 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;
+my %documentedTypes;
+my %usedTypes; # hash recording all refered types in the doc
 
 die "missing refman.tex path_name as unique argument to this script" unless defined $ARGV[0];
 
@@ -62,25 +75,39 @@ die "missing refman.tex path_name as unique argument to this script" unless defi
 sub scanDoc {
     my ($filename) = @_;
     open (DOC, $filename) or die "unable to open " . $filename . "\n";
-    print "------- Testing conformity of refman.tex and meta-information from zinc Version $Tk::Zinc::VERSION\n";
+    my $current_item = 0;
+    my $prev_attribute = 0;
+    my $prev_type = 0;
+
     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";
+	    my $item = $1;
+	    my $attribute = $2;
+	    my $type = $3;
+	    $itemAttributeDoc{$item}{-$attribute} = $type;
+	    if ($item eq $current_item) {
+		if ($attribute lt $prev_attribute) {
+		    print "W: attributes $prev_attribute and $attribute are not in alphabetical order for $item\n";
 		}
 	    }
 	    else {
-		$current_item = $1;
-		$prev_attribute = $2;
+		$current_item = $item;
+		$prev_attribute = $attribute;
 	    }
 	}
 	elsif ( /^\\option\{(\w+)\}\{(\w+)\}\{(\w+)\}/ ) {
-	    # $1 = optionName
-	    # $2 = Database name
-	    # $3 = DatabaseClass
-	    $documentedOptions{-$1}=$3;
+	    my $optionName = $1;
+	    my $databaseName = $2;
+	    my $databaseClass = $3;
+	    $documentedOptions{-$optionName} = $databaseClass;
+	}
+	elsif ( /^\\attrtype\{(\w+)\}/ ) {
+	    my $type = $1;
+	    $documentedTypes{$type} = $type;
+	    if ($type lt $prev_type) {
+		print "W: type $prev_type and $type are not in alphabetical order\n";
+	    }
+	    $prev_type = $type;
 	}
     }
 }
@@ -121,14 +148,22 @@ sub testAllOptions {
 }
 
 sub testAllAttributes {
-    my ($type) = @_;
+    my ($item) = @_;
 
-    my %documentedAttributes = %{$itemAttributeDoc{$type}}; 
-    my @attributes = $zinc->itemconfigure($itemtypes{$type});
+    my %documentedAttributes = %{$itemAttributeDoc{$item}}; 
+    my @attributes = $zinc->itemconfigure($itemtypes{$item});
 
     my %attributes;
     # we use this hashtable to check that all documented attributes
     # are matching all existing attributes in TkZinc
+
+    # verifying that all referenced types are defined
+    # and storing used types
+    foreach my $attribute (sort keys %documentedAttributes) {
+	my $type = $documentedAttributes{$attribute};
+	$usedTypes{$type} = 1;
+	print "E: type $type ($attribute of $item) is not documented\n" unless $documentedTypes{$type};
+    }
     
     foreach my $elem (@attributes) {
 	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
@@ -140,7 +175,7 @@ sub testAllAttributes {
 	# $empty is for provision by Zinc
 	
 	if (!defined $documentedAttributes{$attributeName}) {
-	    print "E: $attributeName ($attributeType) of item $type IS NOT DOCUMENTED!\n";
+	    print "E: $attributeName ($attributeType) of item $item IS NOT DOCUMENTED!\n";
 	    $attributes{$attributeName} = undef;
 	    next;
 	}
@@ -169,6 +204,15 @@ sub testFieldAttributes {
     # we use this hashtable to check that all documented fields attributes
     # are matching all existing fields attributes in TkZinc
     
+    # verifying that all referenced types are defined
+    # and storing used types
+    foreach my $attribute (sort keys %documentedAttributes) {
+	my $type = $documentedAttributes{$attribute};
+	$usedTypes{$type} = 1;
+	print "E: type $type ($attribute of 'field') is not documented\n" unless $documentedTypes{$type};
+    }
+    
+
     foreach my $elem (@attributes) {
 	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
 	$attributes{$attributeName} = [$attributeType, $readOnly, $empty, $attributeValue];
@@ -198,7 +242,11 @@ sub testFieldAttributes {
     }
 }
 
-
+sub verifyingAllDefinedTypesAreUsed {
+    foreach my $type (sort keys %documentedTypes) {
+	print "W: documented type $type is never refered to in the doc\n" unless $usedTypes{$type};
+    }
+}
 
 print "--- TkZinc Options -----------------------------------------\n";
 &testAllOptions;
@@ -211,6 +259,8 @@ foreach my $type (sort keys %itemtypes) {
     &testAllAttributes($type);
 }
 
+&verifyingAllDefinedTypesAreUsed;
+
 print "------- Summary of type discrepencies between Doc and Zinc --------\n";
 printf "%15s |%15s\n", "zinctype","doctype";
 foreach my $typezinc (sort keys %zinc2doc) {