diff options
| -rw-r--r-- | Perl/t/testdoc.pl | 219 |
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; |