- convert t/t15color.t to Test::More

diff --git a/Changes b/Changes
index 505e1d264cb09fecb6c0d2552078af954b8cc960..606366c3c200fd7cb42d92a92754fd98605b1132 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1121,6 +1121,7 @@ Revision history for Perl extension Imager.
 - loading filter DLLs/DSOs had an off-by-one error allocating a buffer
   for the filename of the library (does anyone use this functionality?)
 - remove old #if 0 code from Imager.xs
 - loading filter DLLs/DSOs had an off-by-one error allocating a buffer
   for the filename of the library (does anyone use this functionality?)
 - remove old #if 0 code from Imager.xs

+- convert t/t15color.t to Test::More

 
 =================================================================
 
 
 =================================================================
 

diff --git a/t/t15color.t b/t/t15color.t
index 854be7dd8c0c14819bed1f944c1fcc804a236420..605fcf27006d2a87a06fdb8c43ad36c2bc920e89 100644 (file)
--- a/t/t15color.t
+++ b/t/t15color.t
@@ -7,22 +7,20 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 

-BEGIN { $| = 1; print "1..46\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Imager;
-$loaded = 1;
-print "ok 1\n";
+use Test::More tests => 46;
+
+BEGIN { use_ok('Imager'); };

 
 require "t/testtools.pl";
 
 init_log("testout/t15color.log",1);
 
 my $c1 = Imager::Color->new(100, 150, 200, 250);
 
 require "t/testtools.pl";
 
 init_log("testout/t15color.log",1);
 
 my $c1 = Imager::Color->new(100, 150, 200, 250);

-print test_col($c1, 100, 150, 200, 250) ? "ok 2\n" : "not ok 2\n";
+ok(test_col($c1, 100, 150, 200, 250), 'simple 4-arg');

 my $c2 = Imager::Color->new(100, 150, 200);
 my $c2 = Imager::Color->new(100, 150, 200);

-print test_col($c2, 100, 150, 200, 255) ? "ok 3\n" : "not ok 3\n";
+ok(test_col($c2, 100, 150, 200, 255), 'simple 3-arg');

 my $c3 = Imager::Color->new("#6496C8");
 my $c3 = Imager::Color->new("#6496C8");

-print test_col($c3, 100, 150, 200, 255) ? "ok 4\n" : "not ok 4\n";
+ok(test_col($c3, 100, 150, 200, 255), 'web color');

 # crashes in Imager-0.38pre8 and earlier
 my @foo;
 for (1..1000) {
 # crashes in Imager-0.38pre8 and earlier
 my @foo;
 for (1..1000) {


@@ -34,39 +32,37 @@ for (@foo) {
   Imager::Color::set_internal($_, 128, 128, 128, 128) == $_ or ++$fail;
   test_col($_, 128, 128, 128, 128) or ++$fail;
 }
   Imager::Color::set_internal($_, 128, 128, 128, 128) == $_ or ++$fail;
   test_col($_, 128, 128, 128, 128) or ++$fail;
 }

-$fail and print "not ";
-print "ok 5\n";
+ok(!$fail, 'consitency check');

 
 # test the new OO methods
 
 # test the new OO methods

-color_ok(6, 100, 150, 200, 255, Imager::Color->new(r=>100, g=>150, b=>200));
-color_ok(7, 101, 151, 201, 255, 
+color_ok('r g b',, 100, 150, 200, 255, Imager::Color->new(r=>100, g=>150, b=>200));
+color_ok('red green blue', 101, 151, 201, 255, 

          Imager::Color->new(red=>101, green=>151, blue=>201));
          Imager::Color->new(red=>101, green=>151, blue=>201));

-color_ok(8, 102, 255, 255, 255, Imager::Color->new(grey=>102));
-color_ok(9, 103, 255, 255, 255, Imager::Color->new(gray=>103));
-if (-e '/usr/lib/X11/rgb.txt') {
-  color_ok(10, 0, 0, 255, 255, Imager::Color->new(xname=>'blue'));
-}
-else {
-  print "ok 10 # skip - no X rgb.txt found\n";
+color_ok('grey', 102, 255, 255, 255, Imager::Color->new(grey=>102));
+color_ok('gray', 103, 255, 255, 255, Imager::Color->new(gray=>103));
+SKIP:
+{
+  skip "no X rgb.txt found", 1 unless -e '/usr/lib/X11/rgb.txt';
+  color_ok('xname', 0, 0, 255, 255, Imager::Color->new(xname=>'blue'));

 }
 }

-color_ok(11, 255, 250, 250, 255, 
+color_ok('gimp', 255, 250, 250, 255, 

          Imager::Color->new(gimp=>'snow', palette=>'testimg/test_gimp_pal'));
          Imager::Color->new(gimp=>'snow', palette=>'testimg/test_gimp_pal'));

-color_ok(12, 255, 255, 255, 255, Imager::Color->new(h=>0, 's'=>0, 'v'=>1.0));
-color_ok(13, 255, 0, 0, 255, Imager::Color->new(h=>0, 's'=>1, v=>1));
-color_ok(14, 128, 129, 130, 255, Imager::Color->new(web=>'#808182'));
-color_ok(15, 0x11, 0x22, 0x33, 255, Imager::Color->new(web=>'#123'));
-color_ok(16, 255, 150, 121, 255, Imager::Color->new(rgb=>[ 255, 150, 121 ]));
-color_ok(17, 255, 150, 121, 128, 
+color_ok('h s v', 255, 255, 255, 255, Imager::Color->new(h=>0, 's'=>0, 'v'=>1.0));
+color_ok('h s v again', 255, 0, 0, 255, Imager::Color->new(h=>0, 's'=>1, v=>1));
+color_ok('web 6 digit', 128, 129, 130, 255, Imager::Color->new(web=>'#808182'));
+color_ok('web 3 digit', 0x11, 0x22, 0x33, 255, Imager::Color->new(web=>'#123'));
+color_ok('rgb arrayref', 255, 150, 121, 255, Imager::Color->new(rgb=>[ 255, 150, 121 ]));
+color_ok('rgba arrayref', 255, 150, 121, 128, 

          Imager::Color->new(rgba=>[ 255, 150, 121, 128 ]));
          Imager::Color->new(rgba=>[ 255, 150, 121, 128 ]));

-color_ok(18, 255, 0, 0, 255, Imager::Color->new(hsv=>[ 0, 1, 1 ]));
-color_ok(19, 129, 130, 131, 134, 
+color_ok('hsv arrayref', 255, 0, 0, 255, Imager::Color->new(hsv=>[ 0, 1, 1 ]));
+color_ok('channel0-3', 129, 130, 131, 134, 

          Imager::Color->new(channel0=>129, channel1=>130, channel2=>131,
                             channel3=>134));
          Imager::Color->new(channel0=>129, channel1=>130, channel2=>131,
                             channel3=>134));

-color_ok(20, 129, 130, 131, 134, 
+color_ok('c0-3', 129, 130, 131, 134, 

          Imager::Color->new(c0=>129, c1=>130, c2=>131, c3=>134));
          Imager::Color->new(c0=>129, c1=>130, c2=>131, c3=>134));

-color_ok(21, 200, 201, 203, 204, 
+color_ok('channels arrayref', 200, 201, 203, 204, 

          Imager::Color->new(channels=>[ 200, 201, 203, 204 ]));
          Imager::Color->new(channels=>[ 200, 201, 203, 204 ]));

-color_ok(22, 255, 250, 250, 255, 
+color_ok('name', 255, 250, 250, 255, 

          Imager::Color->new(name=>'snow', palette=>'testimg/test_gimp_pal'));
 
 # test the internal HSV <=> RGB conversions
          Imager::Color->new(name=>'snow', palette=>'testimg/test_gimp_pal'));
 
 # test the internal HSV <=> RGB conversions


@@ -91,33 +87,33 @@ for my $entry (@hsv_vs_rgb) {
   my $rgb = $entry->{rgb};
   my $fhsvo = Imager::Color::Float->new($hsv->[0]/360.0, $hsv->[1], $hsv->[2]);
   my $fc = Imager::Color::Float::i_hsv_to_rgb($fhsvo);
   my $rgb = $entry->{rgb};
   my $fhsvo = Imager::Color::Float->new($hsv->[0]/360.0, $hsv->[1], $hsv->[2]);
   my $fc = Imager::Color::Float::i_hsv_to_rgb($fhsvo);

-  fcolor_close_enough($test_num++, $rgb->[0]/255, $rgb->[1]/255, 
+  fcolor_close_enough("i_hsv_to_rgbf $index", $rgb->[0]/255, $rgb->[1]/255, 

                       $rgb->[2]/255, $fc);
   my $fc2 = Imager::Color::Float::i_rgb_to_hsv($fc);
                       $rgb->[2]/255, $fc);
   my $fc2 = Imager::Color::Float::i_rgb_to_hsv($fc);

-  fcolor_close_enough($test_num++, $hsv->[0]/360.0, $hsv->[1], $hsv->[2], 
+  fcolor_close_enough("i_rgbf_to_hsv $index", $hsv->[0]/360.0, $hsv->[1], $hsv->[2], 

                       $fc2);
 
   my $hsvo = Imager::Color->new($hsv->[0]*255/360.0, $hsv->[1] * 255, 
                                 $hsv->[2] * 255);
   my $c = Imager::Color::i_hsv_to_rgb($hsvo);
                       $fc2);
 
   my $hsvo = Imager::Color->new($hsv->[0]*255/360.0, $hsv->[1] * 255, 
                                 $hsv->[2] * 255);
   my $c = Imager::Color::i_hsv_to_rgb($hsvo);

-  color_close_enough($test_num++, @$rgb, $c);
+  color_close_enough("i_hsv_to_rgb $index", @$rgb, $c);

   my $c2 = Imager::Color::i_rgb_to_hsv($c);
   my $c2 = Imager::Color::i_rgb_to_hsv($c);

-  color_close_enough_hsv($test_num++, $hsv->[0]*255/360.0, $hsv->[1] * 255, 
+  color_close_enough_hsv("i_rgb_to_hsv $index", $hsv->[0]*255/360.0, $hsv->[1] * 255, 

                      $hsv->[2] * 255, $c2);
   ++$index;
 }
 
 # check the built-ins table
                      $hsv->[2] * 255, $c2);
   ++$index;
 }
 
 # check the built-ins table

-color_ok($test_num++, 0, 0, 0, 255, 
+color_ok('builtin black', 0, 0, 0, 255, 

        Imager::Color->new(builtin=>'black'));
 
 {
   my $c1 = Imager::Color->new(255, 255, 255, 0);
   my $c2 = Imager::Color->new(255, 255, 255, 255);
        Imager::Color->new(builtin=>'black'));
 
 {
   my $c1 = Imager::Color->new(255, 255, 255, 0);
   my $c2 = Imager::Color->new(255, 255, 255, 255);

-  okn($test_num++, !$c1->equals(other=>$c2), "not equal no ignore alpha");
-  okn($test_num++, scalar($c1->equals(other=>$c2, ignore_alpha=>1)), 
+  ok(!$c1->equals(other=>$c2), "not equal no ignore alpha");
+  ok(scalar($c1->equals(other=>$c2, ignore_alpha=>1)), 

       "equal with ignore alpha");
       "equal with ignore alpha");

-  okn($test_num++, $c1->equals(other=>$c1), "equal to itself");
+  ok($c1->equals(other=>$c1), "equal to itself");

 }
  
 sub test_col {
 }
  
 sub test_col {


@@ -131,19 +127,15 @@ sub test_col {
 }
 
 sub color_close_enough {
 }
 
 sub color_close_enough {

-  my ($test_num, $r, $g, $b, $c) = @_;
+  my ($name, $r, $g, $b, $c) = @_;

 
   my ($cr, $cg, $cb) = $c->rgba;
 
   my ($cr, $cg, $cb) = $c->rgba;

-  if (abs($cr-$r) <= 5 && abs($cg-$g) <= 5 && abs($cb-$b) <= 5) {
-    print "ok $test_num # ($cr, $cg, $cb) <=> ($r, $g, $b)\n";
-  }
-  else {
-    print "not ok $test_num # ($cr, $cg, $cb) <=> ($r, $g, $b)\n";
-  }
+  ok(abs($cr-$r) <= 5 && abs($cg-$g) <= 5 && abs($cb-$b) <= 5,
+    "$name - ($cr, $cg, $cb) <=> ($r, $g, $b)");

 }
 
 sub color_close_enough_hsv {
 }
 
 sub color_close_enough_hsv {

-  my ($test_num, $h, $s, $v, $c) = @_;
+  my ($name, $h, $s, $v, $c) = @_;

 
   my ($ch, $cs, $cv) = $c->rgba;
   if ($ch < 5 && $h > 250) {
 
   my ($ch, $cs, $cv) = $c->rgba;
   if ($ch < 5 && $h > 250) {


@@ -152,34 +144,22 @@ sub color_close_enough_hsv {
   elsif ($ch > 250 && $h < 5) {
     $h += 255;
   }
   elsif ($ch > 250 && $h < 5) {
     $h += 255;
   }

-  if (abs($ch-$h) <= 5 && abs($cs-$s) <= 5 && abs($cv-$v) <= 5) {
-    print "ok $test_num # ($ch, $cs, $cv) <=> ($h, $s, $v)\n";
-  }
-  else {
-    print "not ok $test_num # ($ch, $cs, $cv) <=> ($h, $s, $v)\n";
-  }
+  ok(abs($ch-$h) <= 5 && abs($cs-$s) <= 5 && abs($cv-$v) <= 5,
+    "$name - ($ch, $cs, $cv) <=> ($h, $s, $v)");

 }
 
 sub fcolor_close_enough {
 }
 
 sub fcolor_close_enough {

-  my ($test_num, $r, $g, $b, $c) = @_;
+  my ($name, $r, $g, $b, $c) = @_;

 
   my ($cr, $cg, $cb) = $c->rgba;
 
   my ($cr, $cg, $cb) = $c->rgba;

-  if (abs($cr-$r) <= 0.01 && abs($cg-$g) <= 0.01 && abs($cb-$b) <= 0.01) {
-    print "ok $test_num\n";
-  }
-  else {
-    print "not ok $test_num # ($cr, $cg, $cb) <=> ($r, $g, $b)\n";
-  }
+  ok(abs($cr-$r) <= 0.01 && abs($cg-$g) <= 0.01 && abs($cb-$b) <= 0.01,
+    "$name - ($cr, $cg, $cb) <=> ($r, $g, $b)");

 }
 
 sub color_ok {
 }
 
 sub color_ok {

-  my ($test_num, $r, $g, $b, $a, $c) = @_;
+  my ($name, $r, $g, $b, $a, $c) = @_;

 
 

-  if (test_col($c, $r, $g, $b, $a)) {
-    print "ok $test_num\n";
-  }
-  else {
-    print "not ok $test_num\n";
+  unless (ok(test_col($c, $r, $g, $b, $a), $name)) {

     print "# ($r,$g,$b,$a) != (".join(",", $c ? $c->rgba: ()).")\n";
   }
 }
     print "# ($r,$g,$b,$a) != (".join(",", $c ? $c->rgba: ()).")\n";
   }
 }