From 56b9f8f00221456006046f4a85b1f6836845d891 Mon Sep 17 00:00:00 2001 From: mertz Date: Thu, 23 Jun 2005 18:16:12 +0000 Subject: 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 --- Perl/t/Bbox-curve-multi-contour.pl | 183 ------------------------------------- Perl/t/Bbox-curve-multi-contour.t | 183 +++++++++++++++++++++++++++++++++++++ 2 files changed, 183 insertions(+), 183 deletions(-) delete mode 100644 Perl/t/Bbox-curve-multi-contour.pl create mode 100644 Perl/t/Bbox-curve-multi-contour.t 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; -} diff --git a/Perl/t/Bbox-curve-multi-contour.t b/Perl/t/Bbox-curve-multi-contour.t new file mode 100644 index 0000000..7afc43c --- /dev/null +++ b/Perl/t/Bbox-curve-multi-contour.t @@ -0,0 +1,183 @@ +#!/usr/bin/perl -w + +# +# $Id: Bbox-curve-multi-contour.t,v 1.1 2005-06-23 18:16:12 mertz Exp $ +# 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; +} -- cgit v1.1