[rt.cpan.org #65385] Patch for Imager::Color->hsv

[imager.git] / t / t67convert.t

diff --git a/t/t67convert.t b/t/t67convert.t
index 3661b45ef63e49e9a3b51d63156f2349ab00525d..fe89401600bf358259e0a8aae255a3f985ffa8cf 100644 (file)
--- a/t/t67convert.t
+++ b/t/t67convert.t
@@ -1,7 +1,8 @@
 #!perl -w
 use strict;
 use Imager qw(:all :handy);
-use Test::More tests=>19;
+use Test::More tests => 27;
+use Imager::Test qw(test_colorf_gpix is_fcolor1 is_fcolor3);
 
 Imager::init("log"=>'testout/t67convert.log');
 
@@ -10,13 +11,13 @@ my $imbase = Imager::ImgRaw::new(200,300,3);
 # first a basic test, make sure the basic things happen ok
 # make a 1 channel image from the above (black) image
 # but with 1 as the 'extra' value
-my $imnew = Imager::i_img_new();
 SKIP:
 {
+  my $im_white = i_convert($imbase, [ [ 0, 0, 0, 1 ] ]);
   skip("convert to white failed", 3)
-    unless ok(i_convert($imnew, $imbase, [ [ 0, 0, 0, 1 ] ]), "convert to white");
+    unless ok($im_white, "convert to white");
 
-  my ($w, $h, $ch) = i_img_info($imnew);
+  my ($w, $h, $ch) = i_img_info($im_white);
 
   # the output image should now have one channel
   is($ch, 1, "one channel image now");
@@ -24,7 +25,7 @@ SKIP:
   ok($w == 200 && $h == 300, "check converted size is the same");
 
   # should be a white image now, let's check
-  my $c = Imager::i_get_pixel($imnew, 20, 20);
+  my $c = Imager::i_get_pixel($im_white, 20, 20);
   my @c = $c->rgba;
   print "# @c\n";
   is($c[0], 255, "check image is white");
@@ -49,21 +50,41 @@ SKIP:
 }
 
 # test against 16-bit/sample images
-my $im16targ = Imager::i_img_16_new(200, 300, 3);
-SKIP:
 {
-  skip("could not convert 16-bit image", 2)
-    unless ok(i_convert($im16targ, $imbase, [ [ 0, 0, 0, 1 ],
-                                              [ 0, 0, 0, 0 ],
-                                              [ 0, 0, 0, 0 ] ]),
-              "convert 16/bit sample image");
-  # image should still be 16-bit
-  is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample");
-  # make sure that it's roughly red
-  my $c = Imager::i_gpixf($im16targ, 0, 0);
-  my @ch = $c->rgba;
-  ok(abs($ch[0] - 1) <= 0.0001 && abs($ch[1]) <= 0.0001 && abs($ch[2]) <= 0.0001,
-     "image roughly red");
+ SKIP:
+  {
+    my $imbase16 = Imager::i_img_16_new(200, 200, 3);
+
+    my $im16targ = i_convert($imbase16, [ [ 0, 0, 0, 1 ],
+                                         [ 0, 0, 0, 0 ],
+                                         [ 0, 0, 0, 0 ] ]);
+    ok($im16targ, "convert 16/bit sample image")
+      or skip("could not convert 16-bit image", 2);
+
+    # image should still be 16-bit
+    is(Imager::i_img_bits($im16targ), 16, "Image still 16-bit/sample");
+
+    # make sure that it's roughly red
+    test_colorf_gpix($im16targ, 0, 0, NCF(1, 0, 0), 0.001, "image roughly red");
+  }
+ SKIP:
+  {
+    my $imbase16 = Imager->new(xsize => 10, ysize => 10, bits => 16);
+    ok($imbase16->setpixel
+       (x => 5, y => 2, color => Imager::Color::Float->new(0.1, 0.2, 0.3)),
+       "set a sample pixel");
+    my $c1 = $imbase16->getpixel(x => 5, y => 2, type => "float");
+    is_fcolor3($c1, 0.1, 0.2, 0.3, "check it was set")
+      or print "#", join(",", $c1->rgba), "\n";
+    
+    my $targ16 = $imbase16->convert(matrix => [ [ 0.05, 0.15, 0.01, 0.5 ] ]);
+    ok($targ16, "convert another 16/bit sample image")
+      or skip("could not convert", 3);
+    is($targ16->getchannels, 1, "convert should be 1 channel");
+    is($targ16->bits, 16, "and 16-bits");
+    my $c = $targ16->getpixel(x => 5, y => 2, type => "float");
+    is_fcolor1($c, 0.538, 1/32768, "check grey value");
+  }
 }
 
 # test against palette based images
@@ -74,14 +95,14 @@ ok($blackindex, "add black to paletted");
 for my $y (0..299) {
   Imager::i_ppal($impal, 0, $y, ($blackindex) x 200);
 }
-my $impalout = Imager::i_img_pal_new(200, 300, 3, 256);
+
 SKIP:
 {
+  my $impalout = i_convert($impal, [ [ 0, 0, 0, 0 ],
+                                    [ 0, 0, 0, 1 ],
+                                    [ 0, 0, 0, 0 ] ]);
   skip("could not convert paletted", 3)
-    unless ok(i_convert($impalout, $impal, [ [ 0, 0, 0, 0 ],
-                                   [ 0, 0, 0, 1 ],
-                                   [ 0, 0, 0, 0 ] ]),
-             "convert paletted");
+    unless ok($impalout, "convert paletted");
   is(Imager::i_img_type($impalout), 1, "image still paletted");
   is(Imager::i_colorcount($impalout), 1, "still only one colour");
   my $c = Imager::i_getcolors($impalout, $blackindex);
@@ -93,6 +114,7 @@ SKIP:
 }
 
 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
+  # methods that return a new image should warn in void context
   my $warning;
   local $SIG{__WARN__} = 
     sub { 
@@ -107,3 +129,12 @@ SKIP:
   cmp_ok($warning, '=~', 'void', "correct warning");
   cmp_ok($warning, '=~', 't67convert\\.t', "correct file");
 }
+
+{ # http://rt.cpan.org/NoAuth/Bug.html?id=28492
+  # convert() doesn't preserve image sample size
+  my $im = Imager->new(xsize => 20, ysize => 20, channels => 3, 
+                      bits => 'double');
+  is($im->bits, 'double', 'check source bits');
+  my $conv = $im->convert(preset => 'grey');
+  is($conv->bits, 'double', 'make sure result has extra bits');
+}