aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Perl/t/testdoc.pl219
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;