renaming a script as a test script (.t suffix)

This test script exhibits a bug of the 3.3.0 Tkzinc, as reported
by Daniel Etienne (12th April 2005) and solved in the 3.3.2 release
of TkZinc

1 files changed, 0 insertions, 183 deletions

diff --git a/Perl/t/Bbox-curve-multi-contour.pl b/Perl/t/Bbox-curve-multi-contour.pl
deleted file mode 100644
index cf66e40..0000000
--- a/Perl/t/Bbox-curve-multi-contour.pl
+++ /dev/null
@@ -1,183 +0,0 @@
-#!/usr/bin/perl -w 
-
-#
-# $Id$
-# Author: Christophe Mertz  mertz@intuilab.com, adapted from a script 
-# reported by Daniel Etienne for a bug report in Tk::Zinc 3.3.0
-#
-
-use strict;
-
-# testing all the import
-
-BEGIN {
-    if (!eval q{
-#        use Test::More qw(no_plan);
-        use Test::More tests => 4;
-        1;
-    }) {
-        print "# tests only work properly with installed Test::More module\n";
-        print "1..1\n";
-        print "ok 1\n";
-        exit;
-    }
-    if (!eval q{
-	use Tk::Zinc;
- 	1;
-    }) {
-        print "unable to load Tk::Zinc";
-        print "1..1\n";
-        print "ok 1\n";
-        exit;
-    }
-}
-use Tk;
-
-my $mw = MainWindow->new;
-my $zinc = $mw->Zinc(-render => 1, -width => 800, -height => 500);
-$zinc->pack;
-like  ($zinc, qr/^Tk::Zinc=HASH/ , "zinc has been created");
-
-my $n = 8;
-
-
-# first
-my $group = $zinc->add('group', 1);
-$zinc->coords($group, [100, 250]);
-
-my $curve = $zinc->add('curve', $group, [],
-		       -fillrule => 'nonzero',
-		       -closed => 1,
-		       -filled => 1,
-		       -fillcolor => 'black',
-		       -linecolor => 'red',
-		       );
-my $arc = $zinc->add('arc', $group, [-50, -50, 50, 50]);
-$zinc->contour($curve, 'add', 1, $arc);
-$zinc->remove($arc);
-
-for (1..$n) {
-    my $arc = $zinc->add('arc', $group, [-15, -70, 15, -40]);
-    $zinc->rotate($arc, ($_-1)*(360/$n), 'degree');
-    $zinc->contour($curve, 'add', 1, $arc);
-    $zinc->remove($arc);
-}
-
-ok(&similarFlatArray ([$zinc->bbox($group)],
-                      [28,178, 172, 322],   # beware this coordinates are
-                                            # not exactly the good one
-                      [2,2,   2,2 ],
-                     ),
-   "bbox of left figure");
-
-
-# second
-$group = $zinc->add('group', 1);
-$zinc->coords($group, [350, 250]);
-
-$curve = $zinc->add('curve', $group, [],
-		       -fillrule => 'nonzero',
-		       -closed => 1,
-		       -filled => 1,
-		       -fillcolor => 'black',
-		       -linecolor => 'red',
-		       );
-$arc = $zinc->add('arc', $group, [-30, -30, 30, 30]);
-$zinc->contour($curve, 'add', 1, $arc);
-$zinc->remove($arc);
-
-for (1..$n) {
-    my $arc = $zinc->add('arc', $group, [-15, -70, 15, -40]);
-    $zinc->rotate($arc, ($_-1)*(360/$n), 'degree');
-    $zinc->contour($curve, 'add', 1, $arc);
-    $zinc->remove($arc);
-}
-&showbbox($group);
-ok(&similarFlatArray ([$zinc->bbox($group)],
-                      [278,178, 422,322],   # beware this coordinates are 
-                                             # not exactly the good one
-                      [2,2,   2,2 ],
-                     ),
-   "bbox of middle figure");
-
-
-# third
-$group = $zinc->add('group', 1);
-$zinc->coords($group, [600, 250]);
-
-$curve = $zinc->add('curve', $group, [],
-		       -fillrule => 'nonzero',
-		       -closed => 1,
-		       -filled => 1,
-		       -fillcolor => 'black',
-		       -linecolor => 'red',
-		       );
-$arc = $zinc->add('arc', $group, [-30, -30, 30, 30]);
-$zinc->contour($curve, 'add', 1, $arc);
-$zinc->remove($arc);
-$n = 3*$n;
-for (1..$n) {
-    $arc = $zinc->add('arc', $group, [-5, -70, 5, -40]);
-    $zinc->rotate($arc, ($_-1)*(360/$n), 'degree');
-    $zinc->contour($curve, 'add', 1, $arc);
-    $zinc->remove($arc);
-}
-&showbbox($group);
-ok(&similarFlatArray ([$zinc->bbox($group)],
-                      [528,178, 672, 322],   # beware this coordinates are 
-                                             # not exactly the good one
-                      [2,2,   2,2 ],
-                     ),
-   "bbox of right figure");
-
-
-$zinc->update;
-#sleep 2;
-
-#MainLoop;
-
-
-
-sub showbbox {
-    my @b = $zinc->bbox(shift);
-#    print "bbox @b\n";
-    $zinc->add('rectangle', 1, [@b],
-	       -filled => 0, -linecolor => 'green', -tags => ['bbox']);
-}
-
-## ref1 is the gotten array
-## ref2 is the expected array
-sub similarFlatArray {
-  my ($ref1, $ref2, $deltaref)= @_;
-  diag ("waiting a reference for \$ref1"), return 0 unless ref ($ref1) eq 'ARRAY';
-  diag ("waiting a reference for \$ref2"), return 0 unless ref ($ref2) eq 'ARRAY';
-  diag ("waiting a reference for \$deltaref"), return 0 unless ref ($deltaref) eq 'ARRAY';
-  
-  my @array1 = @{$ref1};
-  my @array2 = @{$ref2};
-  my @deltaarray = @{$deltaref};
-  diag ("arrays gotten, expected and deltas are not of same length,".$#array1.",".$#array2.",".$#deltaarray), return 0 
-    unless ($#array1 == $#array2) and ($#array2 == $#deltaarray);
-  for my $i (0.. $#array1) {
-    my $a = $array1[$i];
-    my $b = $array2[$i];
-    my $delta = $deltaarray[$i];
-    diag ("waiting a numeric value for elt $i of gotten array"), return 0 
-      unless &numerical($a);
-    diag ("waiting a numeric value for elt $i of expected array"), return 0 
-      unless &numerical($b);
-    diag ("waiting a numeric value for elt $i of deltas array"), return 0 
-      unless &numerical($delta);
-        
-    diag ("delta > $delta between elt $i of gotten array ($a) and expected array ($b)"), return 0 
-      if (abs($a-$b) > $delta) ;
-  }
-  return 1;
-}
-
-sub numerical {
-  my ($v) = @_;
-  return 0 unless defined $v;
-  ### this really works!!
-  return $v eq $v*1;
-}