eliminate t/testtools.pl
authorTony Cook <tony@develop=help.com>
Tue, 29 Apr 2008 02:05:22 +0000 (02:05 +0000)
committerTony Cook <tony@develop=help.com>
Tue, 29 Apr 2008 02:05:22 +0000 (02:05 +0000)
have t/t35ttfont.pl check the font is created, this may have been the
cause of the failure at
http://www.nntp.perl.org/group/perl.cpan.testers/1313902

lib/Imager/Test.pm
t/t01introvert.t
t/t022double.t
t/t102png.t
t/t105gif.t
t/t35ttfont.t
t/t40scale.t
t/t65crop.t
t/testtools.pl [deleted file]

index a830070..a491294 100644 (file)
@@ -4,13 +4,26 @@ use Test::Builder;
 require Exporter;
 use vars qw(@ISA @EXPORT_OK);
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(diff_text_with_nul 
-                test_image_raw test_image_16 test_image test_image_double 
-                is_color3 is_color1 is_color4 is_color_close3
-                is_fcolor4
-                is_image is_image_similar 
-                image_bounds_checks mask_tests
-                test_colorf_gpix test_color_gpix test_colorf_glin);
+@EXPORT_OK = 
+  qw(
+     diff_text_with_nul 
+     test_image_raw
+     test_image_16
+     test_image
+     test_image_double 
+     is_color1
+     is_color3
+     is_color4
+     is_color_close3
+     is_fcolor4
+     color_cmp
+     is_image
+     is_image_similar 
+     image_bounds_checks
+     mask_tests
+     test_colorf_gpix
+     test_color_gpix
+     test_colorf_glin);
 
 sub diff_text_with_nul {
   my ($desc, $text1, $text2, @params) = @_;
@@ -363,11 +376,14 @@ sub test_colorf_gpix {
     $builder->ok(0, "$comment - retrieve color at ($x,$y)");
     return;
   }
-  unless ($builder->ok(_colorf_cmp($c, $expected, $epsilon) == 0,
+  unless ($builder->ok(colorf_cmp($c, $expected, $epsilon) == 0,
             "$comment - got right color ($x, $y)")) {
-    print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
-    print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
-    return;
+    my @c = $c->rgba;
+    my @exp = $expected->rgba;
+    $builder->diag(<<EOS);
+# got: ($c[0], $c[1], $c[2])
+# expected: ($exp[0], $exp[1], $exp[2])
+EOS
   }
   1;
 }
@@ -383,10 +399,14 @@ sub test_color_gpix {
     $builder->ok(0, "$comment - retrieve color at ($x,$y)");
     return;
   }
-  unless ($builder->ok(_color_cmp($c, $expected) == 0,
+  unless ($builder->ok(color_cmp($c, $expected) == 0,
      "got right color ($x, $y)")) {
-    print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
-    print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
+    my @c = $c->rgba;
+    my @exp = $expected->rgba;
+    $builder->diag(<<EOS);
+# got: ($c[0], $c[1], $c[2])
+# expected: ($exp[0], $exp[1], $exp[2])
+EOS
     return;
   }
 
@@ -402,11 +422,11 @@ sub test_colorf_glin {
   @got == @$pels
     or return $builder->is_num(scalar(@got), scalar(@$pels), "$comment - pixels retrieved");
   
-  return $builder->ok(!grep(_colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
+  return $builder->ok(!grep(colorf_cmp($pels->[$_], $got[$_], 0.005), 0..$#got),
      "$comment - check colors ($x, $y)");
 }
 
-sub _colorf_cmp {
+sub colorf_cmp {
   my ($c1, $c2, $epsilon) = @_;
 
   defined $epsilon or $epsilon = 0;
@@ -420,7 +440,7 @@ sub _colorf_cmp {
       || abs($s1[2]-$s2[2]) >= $epsilon && $s1[2] <=> $s2[2];
 }
 
-sub _color_cmp {
+sub color_cmp {
   my ($c1, $c2) = @_;
 
   my @s1 = $c1->rgba;
index c9ae822..85d3792 100644 (file)
@@ -3,13 +3,11 @@
 # to make sure we get expected values
 
 use strict;
-use Test::More tests => 228;
+use Test::More tests => 220;
 
 BEGIN { use_ok(Imager => qw(:handy :all)) }
 
-require "t/testtools.pl";
-
-use Imager::Test qw(image_bounds_checks is_color4 is_fcolor4);
+use Imager::Test qw(image_bounds_checks is_color3 is_color4 is_fcolor4 color_cmp mask_tests);
 
 init_log("testout/t01introvert.log",1);
 
@@ -82,10 +80,10 @@ is($samp, "\xFF\0\0" x 50 . "\0\0\xFF" x 50, "gsamp scalar bytes");
 # reading indicies as colors
 my $c_red = Imager::i_get_pixel($im_pal, 0, 0);
 ok($c_red, "got the red pixel");
-ok(color_cmp($red, $c_red) == 0, "and it's red");
+is_color3($c_red, 255, 0, 0, "and it's red");
 my $c_blue = Imager::i_get_pixel($im_pal, 50, 0);
 ok($c_blue, "got the blue pixel");
-ok(color_cmp($blue, $c_blue) == 0, "and it's blue");
+is_color3($c_blue, 0, 0, 255, "and it's blue");
 
 # drawing with colors
 ok(Imager::i_ppix($im_pal, 0, 0, $green) == 0, "draw with color in palette");
@@ -94,7 +92,7 @@ is(Imager::i_img_type($im_pal), 1, "image still paletted");
 
 my $c_green = Imager::i_get_pixel($im_pal, 0, 0);
 ok($c_green, "got green pixel");
-ok(color_cmp($green, $c_green) == 0, "and it's green");
+is_color3($c_green, 0, 255, 0, "and it's green");
 
 is(Imager::i_colorcount($im_pal), 3, "still 3 colors in palette");
 is(Imager::i_findcolor($im_pal, $green), 1, "and green is the second");
@@ -132,7 +130,7 @@ is($impal2->type, 'paletted', "check type");
   is($blue_idx, 1, "and it's expected index for blue");
   my $green_idx = $blue_idx + 1;
   my $c = $impal2->getcolors(start=>$green_idx);
-  ok(color_cmp($green, $c) == 0, "found green where expected");
+  is_color3($c, 0, 255, 0, "found green where expected");
   my @cols = $impal2->getcolors;
   is(@cols, 3, "got 3 colors");
   my @exp = ( $red, $blue, $green );
@@ -267,8 +265,8 @@ cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
 
   my @row = Imager::i_glin($im->{IMG}, 0, 2, 0);
   is(@row, 2, "got 2 pixels from i_glin");
-  ok(color_cmp($row[0], $red) == 0, "red first");
-  ok(color_cmp($row[1], $blue) == 0, "then blue");
+  is_color3($row[0], 255, 0, 0, "red first");
+  is_color3($row[1], 0, 0, 255, "then blue");
 }
 
 { # general tag tests
index e5234b1..c2ec684 100644 (file)
@@ -1,13 +1,12 @@
 #!perl -w
 use strict;
-use Test::More tests => 98;
+use Test::More tests => 83;
 
 BEGIN { use_ok(Imager => qw(:all :handy)) }
-require "t/testtools.pl";
 
 init_log("testout/t022double.log", 1);
 
-use Imager::Test qw(image_bounds_checks);
+use Imager::Test qw(image_bounds_checks test_colorf_gpix test_colorf_glin mask_tests);
 
 use Imager::Color::Float;
 
@@ -53,12 +52,13 @@ test_colorf_gpix($im_rgb, 0,  0,   $redf);
 test_colorf_gpix($im_rgb, 99, 0,   $redf);
 test_colorf_gpix($im_rgb, 0,  100, $redf);
 test_colorf_gpix($im_rgb, 99, 100, $redf);
-test_colorf_glin($im_rgb, 0,  0,   ($redf) x 100);
-test_colorf_glin($im_rgb, 0,  100, ($redf) x 100);
+test_colorf_glin($im_rgb, 0,  0,   [ ($redf) x 100 ], 'sanity glin @0');
+test_colorf_glin($im_rgb, 0,  100, [ ($redf) x 100 ], 'sanity glin @100');
 
 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
 test_colorf_glin($im_rgb, 0, 1, 
-                 ($redf) x 20, ($greenf) x 60, ($redf) x 20);
+                 [ ($redf) x 20, ($greenf) x 60, ($redf) x 20 ],
+                'check after write');
 
 # basic OO tests
 my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
index 6a2511c..f8da109 100644 (file)
@@ -10,7 +10,6 @@ use Test::More tests => 34;
 # (It may become useful if the test is moved to ./t subdirectory.)
 use lib qw(blib/lib blib/arch);
 
-BEGIN { require 't/testtools.pl'; }
 BEGIN { use_ok('Imager', ':all') }
 init_log("testout/t102png.log",1);
 
index 3d873a9..cf5f3e4 100644 (file)
@@ -15,7 +15,7 @@ $|=1;
 use Test::More tests => 132;
 use Imager qw(:all);
 use Imager::Test qw(is_color3);
-BEGIN { require "t/testtools.pl"; }
+
 use Carp 'confess';
 $SIG{__DIE__} = sub { confess @_ };
 
@@ -186,9 +186,9 @@ SKIP:
       skip("giflib3 doesn't support callbacks", 1) unless $gifver >= 4.0;
       ++$can_write_callback;
       my $good = ext_test(14, <<'ENDOFCODE');
-use Imager;
-require "t/testtools.pl";
-my $timg = test_img();
+use Imager qw(:all);
+use Imager::Test qw(test_image_raw);
+my $timg = test_image_raw();
 my @gif_delays = (50) x 5;
 my @gif_disposal = (2) x 5;
 my @imgs = ($timg) x 5;
index 9e8cf25..aa512cb 100644 (file)
@@ -1,18 +1,17 @@
 #!perl -w
 use strict;
-use Test::More tests => 91;
+use Test::More tests => 92;
 
 $|=1;
 
 BEGIN { use_ok(Imager => ':all') }
-require "t/testtools.pl";
 use Imager::Test qw(diff_text_with_nul is_color3);
 
 init_log("testout/t35ttfont.log",2);
 
 SKIP:
 {
-  skip("freetype 1.x unavailable or disabled", 90
+  skip("freetype 1.x unavailable or disabled", 91
     unless i_has_format("tt");
   print "# has tt\n";
   
@@ -276,16 +275,19 @@ SKIP:
 
     # UTF8 encoded \x{2010}
     my $dash = pack("C*", 0xE2, 0x80, 0x90);
-    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+    diff_text_with_nul("utf8 dash\\0dash vs dash", "$dash\0$dash", $dash,
                       font => $font, color => '#FFFFFF', utf8 => 1);
-    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+    diff_text_with_nul("utf8 dash\\0dash vs dash", "$dash\0$dash", $dash,
                       font => $font, channel => 1, utf8 => 1);
   }
 
+ SKIP:
   { # RT 11972
     # when rendering to a transparent image the coverage should be
     # expressed in terms of the alpha channel rather than the color
     my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'tt');
+    ok($font, "loaded fontfiles/ImUgly.ttf")
+      or skip("Could not load test font: ".Imager->errstr, 4);
     my $im = Imager->new(xsize => 40, ysize => 20, channels => 4);
     ok($im->string(string => "AB", size => 20, aa => 1, color => '#F00',
                   x => 0, y => 15, font => $font),
index 4ffcc25..b2ee906 100644 (file)
@@ -5,8 +5,6 @@ use Test::More tests => 230;
 BEGIN { use_ok(Imager=>':all') }
 use Imager::Test qw(is_image is_color4);
 
-#require "t/testtools.pl";
-
 Imager::init('log'=>'testout/t40scale.log');
 my $img=Imager->new();
 
index 5b98a13..627a86b 100644 (file)
@@ -1,8 +1,8 @@
 #!perl -w
 use strict;
 use Test::More tests => 64;
-require "t/testtools.pl";
 use Imager;
+use Imager::Test qw(test_image);
 
 #$Imager::DEBUG=1;
 
@@ -46,7 +46,7 @@ SKIP:
   # the left of the image, even if left/top are provided, despite the
   # sample in the docs
   # Let's make sure that things happen as documented
-  my $src = test_oo_img();
+  my $src = test_image();
   # make sure we get what we want
   is($src->getwidth, 150, "src width");
   is($src->getheight, 150, "src height");
@@ -146,7 +146,7 @@ SKIP:
 { # https://rt.cpan.org/Ticket/Display.html?id=7581
   # previously we didn't check that the result had some pixels
   # make sure we do
-  my $src = test_oo_img();
+  my $src = test_image();
   ok(!$src->crop(left=>50, right=>50), "nothing across");
   cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
         "and message");
@@ -172,7 +172,7 @@ SKIP:
 }
 
 {
-    my $src = test_oo_img();
+    my $src = test_image();
     ok(!$src->crop( top=>1000, bottom=>1500, left=>0, right=>100 ),
                 "outside of image" );
     cmp_ok($src->errstr, '=~', qr/outside of the image/, "and message");
diff --git a/t/testtools.pl b/t/testtools.pl
deleted file mode 100644 (file)
index 497edc1..0000000
+++ /dev/null
@@ -1,177 +0,0 @@
-# this doesn't need a new namespace - I hope
-use strict;
-use Imager qw(:all);
-use vars qw($TESTNUM);
-use Carp 'confess';
-
-$TESTNUM = 1;
-
-sub test_img {
-  my $green=i_color_new(0,255,0,255);
-  my $blue=i_color_new(0,0,255,255);
-  my $red=i_color_new(255,0,0,255);
-  
-  my $img=Imager::ImgRaw::new(150,150,3);
-  
-  i_box_filled($img,70,25,130,125,$green);
-  i_box_filled($img,20,25,80,125,$blue);
-  i_arc($img,75,75,30,0,361,$red);
-  i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
-
-  $img;
-}
-
-sub test_oo_img {
-  my $raw = test_img();
-  my $img = Imager->new;
-  $img->{IMG} = $raw;
-
-  $img;
-}
-
-
-sub _sv_str {
-  my ($value) = @_;
-
-  if (defined $value) {
-    if (!length $value || ($value & ~$value)) {
-      $value =~ s/\\/\\\\/g;
-      $value =~ s/\r/\\r/g;
-      $value =~ s/\n/\\n/g;
-      $value =~ s/\t/\\t/g;
-      $value =~ s/\"/\\"/g;
-      $value =~ s/([^ -\x7E])/"\\x".sprintf("%02x", ord($1))/ge;
-
-      return qq!"$value"!;
-    }
-    else {
-      return $value; # a number
-    }
-  }
-  else {
-    return "undef";
-  }
-}
-
-
-1;
-
-sub test_colorf_gpix {
-  my ($im, $x, $y, $expected, $epsilon) = @_;
-  my $c = Imager::i_gpixf($im, $x, $y);
-  ok($c, "got gpix ($x, $y)");
-  unless (ok(colorf_cmp($c, $expected, $epsilon) == 0,
-            "got right color ($x, $y)")) {
-    print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
-    print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
-  }
-}
-
-sub test_color_gpix {
-  my ($im, $x, $y, $expected) = @_;
-  my $c = Imager::i_get_pixel($im, $x, $y);
-  ok($c, "got gpix ($x, $y)");
-  unless (ok(color_cmp($c, $expected) == 0,
-     "got right color ($x, $y)")) {
-    print "# got: (", join(",", ($c->rgba)[0,1,2]), ")\n";
-    print "# expected: (", join(",", ($expected->rgba)[0,1,2]), ")\n";
-  }
-}
-
-sub test_colorf_glin {
-  my ($im, $x, $y, @pels) = @_;
-
-  my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
-  is(@got, @pels, "check number of pixels ($x, $y)");
-  ok(!grep(colorf_cmp($pels[$_], $got[$_], 0.005), 0..$#got),
-     "check colors ($x, $y)");
-}
-
-sub colorf_cmp {
-  my ($c1, $c2, $epsilon) = @_;
-
-  defined $epsilon or $epsilon = 0;
-
-  my @s1 = $c1->rgba;
-  my @s2 = $c2->rgba;
-
-  # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
-  return abs($s1[0]-$s2[0]) >= $epsilon && $s1[0] <=> $s2[0] 
-    || abs($s1[1]-$s2[1]) >= $epsilon && $s1[1] <=> $s2[1]
-      || abs($s1[2]-$s2[2]) >= $epsilon && $s1[2] <=> $s2[2];
-}
-
-sub color_cmp {
-  my ($c1, $c2) = @_;
-
-  my @s1 = $c1->rgba;
-  my @s2 = $c2->rgba;
-
-  return $s1[0] <=> $s2[0] 
-    || $s1[1] <=> $s2[1]
-      || $s1[2] <=> $s2[2];
-}
-
-# these test the action of the channel mask on the image supplied
-# which should be an OO image.
-sub mask_tests {
-  my ($im, $epsilon) = @_;
-
-  defined $epsilon or $epsilon = 0;
-
-  # we want to check all four of ppix() and plin(), ppix() and plinf()
-  # basic test procedure:
-  #   first using default/all 1s mask, set to white
-  #   make sure we got white
-  #   set mask to skip a channel, set to grey
-  #   make sure only the right channels set
-
-  print "# channel mask tests\n";
-  # 8-bit color tests
-  my $white = NC(255, 255, 255);
-  my $grey = NC(128, 128, 128);
-  my $white_grey = NC(128, 255, 128);
-
-  print "# with ppix\n";
-  ok($im->setmask(mask=>~0), "set to default mask");
-  ok($im->setpixel(x=>0, 'y'=>0, color=>$white), "set to white all channels");
-  test_color_gpix($im->{IMG}, 0, 0, $white);
-  ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
-  ok($im->setpixel(x=>0, 'y'=>0, color=>$grey), "set to grey, no channel 2");
-  test_color_gpix($im->{IMG}, 0, 0, $white_grey);
-
-  print "# with plin\n";
-  ok($im->setmask(mask=>~0), "set to default mask");
-  ok($im->setscanline(x=>0, 'y'=>1, pixels => [$white]), 
-     "set to white all channels");
-  test_color_gpix($im->{IMG}, 0, 1, $white);
-  ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
-  ok($im->setscanline(x=>0, 'y'=>1, pixels=>[$grey]), 
-     "set to grey, no channel 2");
-  test_color_gpix($im->{IMG}, 0, 1, $white_grey);
-
-  # float color tests
-  my $whitef = NCF(1.0, 1.0, 1.0);
-  my $greyf = NCF(0.5, 0.5, 0.5);
-  my $white_greyf = NCF(0.5, 1.0, 0.5);
-
-  print "# with ppixf\n";
-  ok($im->setmask(mask=>~0), "set to default mask");
-  ok($im->setpixel(x=>0, 'y'=>2, color=>$whitef), "set to white all channels");
-  test_colorf_gpix($im->{IMG}, 0, 2, $whitef, $epsilon);
-  ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
-  ok($im->setpixel(x=>0, 'y'=>2, color=>$greyf), "set to grey, no channel 2");
-  test_colorf_gpix($im->{IMG}, 0, 2, $white_greyf, $epsilon);
-
-  print "# with plinf\n";
-  ok($im->setmask(mask=>~0), "set to default mask");
-  ok($im->setscanline(x=>0, 'y'=>3, pixels => [$whitef]), 
-     "set to white all channels");
-  test_colorf_gpix($im->{IMG}, 0, 3, $whitef, $epsilon);
-  ok($im->setmask(mask=>0xF-0x2), "set channel to exclude channel1");
-  ok($im->setscanline(x=>0, 'y'=>3, pixels=>[$greyf]), 
-     "set to grey, no channel 2");
-  test_colorf_gpix($im->{IMG}, 0, 3, $white_greyf, $epsilon);
-
-}
-