t/t021sixteen.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 155;
   4
   5 BEGIN { use_ok(Imager=>qw(:all :handy)) }
   6
   7 -d "testout" or mkdir "testout";
   8
   9 Imager->open_log(log => "testout/t021sixteen.log");
  10
  11 use Imager::Color::Float;
  12 use Imager::Test qw(test_image is_image image_bounds_checks test_colorf_gpix
  13                     test_colorf_glin mask_tests is_color3);
  14
  15 my $im_g = Imager::i_img_16_new(100, 101, 1);
  16
  17 is(Imager::i_img_getchannels($im_g), 1, "1 channel image channel count");
  18 ok(Imager::i_img_getmask($im_g) & 1, "1 channel image mask");
  19 ok(!Imager::i_img_virtual($im_g), "shouldn't be marked virtual");
  20 is(Imager::i_img_bits($im_g), 16, "1 channel image has bits == 16");
  21 is(Imager::i_img_type($im_g), 0, "1 channel image isn't direct");
  22
  23 my @ginfo = i_img_info($im_g);
  24 is($ginfo[0], 100, "1 channel image width");
  25 is($ginfo[1], 101, "1 channel image height");
  26
  27 undef $im_g;
  28
  29 my $im_rgb = Imager::i_img_16_new(100, 101, 3);
  30
  31 is(Imager::i_img_getchannels($im_rgb), 3, "3 channel image channel count");
  32 ok((Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image mask");
  33 is(Imager::i_img_bits($im_rgb), 16, "3 channel image bits");
  34 is(Imager::i_img_type($im_rgb), 0, "3 channel image type");
  35
  36 my $redf = NCF(1, 0, 0);
  37 my $greenf = NCF(0, 1, 0);
  38 my $bluef = NCF(0, 0, 1);
  39
  40 # fill with red
  41 for my $y (0..101) {
  42   Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
  43 }
  44 pass("fill with red");
  45 # basic sanity
  46 test_colorf_gpix($im_rgb, 0,  0,   $redf, 0, "top-left");
  47 test_colorf_gpix($im_rgb, 99, 0,   $redf, 0, "top-right");
  48 test_colorf_gpix($im_rgb, 0,  100, $redf, 0, "bottom left");
  49 test_colorf_gpix($im_rgb, 99, 100, $redf, 0, "bottom right");
  50 test_colorf_glin($im_rgb, 0,  0,   [ ($redf) x 100 ], "first line");
  51 test_colorf_glin($im_rgb, 0,  100, [ ($redf) x 100 ], "last line");
  52
  53 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
  54 test_colorf_glin($im_rgb, 0, 1,
  55                  [ ($redf) x 20, ($greenf) x 60, ($redf) x 20 ],
  56                 "added some green in the middle");
  57 {
  58   my @samples;
  59   is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, [ 0 .. 2 ]), 12,
  60      "i_gsamp_bits all channels - count")
  61     or print "# ", Imager->_error_as_msg(), "\n";
  62   is_deeply(\@samples, [ 65535, 0, 0,   65535, 0, 0,
  63                          0, 65535, 0,   0, 65535, 0 ],
  64             "check samples retrieved");
  65   @samples = ();
  66   is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, [ 0, 2 ]), 8,
  67      "i_gsamp_bits some channels - count")
  68     or print "# ", Imager->_error_as_msg(), "\n";
  69   is_deeply(\@samples, [ 65535, 0,   65535, 0,
  70                          0, 0,       0, 0     ],
  71             "check samples retrieved");
  72   # fail gsamp
  73   is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, [ 0, 3 ]), undef,
  74      "i_gsamp_bits fail bad channel");
  75   is(Imager->_error_as_msg(), 'No channel 3 in this image', 'check message');
  76
  77   is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 17, \@samples, 0, [ 0, 2 ]), 8,
  78      "i_gsamp_bits succeed high bits");
  79   is($samples[0], 131071, "check correct with high bits");
  80
  81   # write some samples back
  82   my @wr_samples =
  83     (
  84      0, 0, 65535,
  85      65535, 0, 0,
  86      0, 65535, 0,
  87      65535, 65535, 0
  88     );
  89   is(Imager::i_psamp_bits($im_rgb, 18, 2, 16, [ 0 .. 2 ], \@wr_samples),
  90      12, "write 16-bit samples")
  91     or print "# ", Imager->_error_as_msg(), "\n";
  92   @samples = ();
  93   is(Imager::i_gsamp_bits($im_rgb, 18, 22, 2, 16, \@samples, 0, [ 0 .. 2 ]), 12,
  94      "read them back")
  95     or print "# ", Imager->_error_as_msg(), "\n";
  96   is_deeply(\@samples, \@wr_samples, "check they match");
  97   my $c = Imager::i_get_pixel($im_rgb, 18, 2);
  98   is_color3($c, 0, 0, 255, "check it write to the right places");
  99 }
 100
 101 # basic OO tests
 102 my $oo16img = Imager->new(xsize=>200, ysize=>201, bits=>16);
 103 ok($oo16img, "make a 16-bit oo image");
 104 is($oo16img->bits,  16, "test bits");
 105 isnt($oo16img->is_bilevel, "should not be considered mono");
 106 # make sure of error handling
 107 ok(!Imager->new(xsize=>0, ysize=>1, bits=>16),
 108     "fail to create a 0 pixel wide image");
 109 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
 110        "and correct error message");
 111
 112 ok(!Imager->new(xsize=>1, ysize=>0, bits=>16),
 113     "fail to create a 0 pixel high image");
 114 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
 115        "and correct error message");
 116
 117 ok(!Imager->new(xsize=>-1, ysize=>1, bits=>16),
 118     "fail to create a negative width image");
 119 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
 120        "and correct error message");
 121
 122 ok(!Imager->new(xsize=>1, ysize=>-1, bits=>16),
 123     "fail to create a negative height image");
 124 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
 125        "and correct error message");
 126
 127 ok(!Imager->new(xsize=>-1, ysize=>-1, bits=>16),
 128     "fail to create a negative width/height image");
 129 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
 130        "and correct error message");
 131
 132 ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>0),
 133     "fail to create a zero channel image");
 134 cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
 135        "and correct error message");
 136 ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>5),
 137     "fail to create a five channel image");
 138 cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
 139        "and correct error message");
 140
 141 {
 142   # https://rt.cpan.org/Ticket/Display.html?id=8213
 143   # check for handling of memory allocation of very large images
 144   # only test this on 32-bit machines - on a 64-bit machine it may
 145   # result in trying to allocate 4Gb of memory, which is unfriendly at
 146   # least and may result in running out of memory, causing a different
 147   # type of exit
 148  SKIP: {
 149     use Config;
 150     $Config{ptrsize} == 4
 151       or skip("don't want to allocate 4Gb", 10);
 152     my $uint_range = 256 ** $Config{intsize};
 153     print "# range $uint_range\n";
 154     my $dim1 = int(sqrt($uint_range/2))+1;
 155
 156     my $im_b = Imager->new(xsize=>$dim1, ysize=>$dim1, channels=>1, bits=>16);
 157     is($im_b, undef, "integer overflow check - 1 channel");
 158
 159     $im_b = Imager->new(xisze=>$dim1, ysize=>1, channels=>1, bits=>16);
 160     ok($im_b, "but same width ok");
 161     $im_b = Imager->new(xisze=>1, ysize=>$dim1, channels=>1, bits=>16);
 162     ok($im_b, "but same height ok");
 163     cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
 164            "check the error message");
 165
 166     # do a similar test with a 3 channel image, so we're sure we catch
 167     # the same case where the third dimension causes the overflow
 168     my $dim3 = int(sqrt($uint_range / 3 / 2))+1;
 169
 170     $im_b = Imager->new(xsize=>$dim3, ysize=>$dim3, channels=>3, bits=>16);
 171     is($im_b, undef, "integer overflow check - 3 channel");
 172
 173     $im_b = Imager->new(xisze=>$dim3, ysize=>1, channels=>3, bits=>16);
 174     ok($im_b, "but same width ok");
 175     $im_b = Imager->new(xisze=>1, ysize=>$dim3, channels=>3, bits=>16);
 176     ok($im_b, "but same height ok");
 177
 178     cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
 179            "check the error message");
 180
 181     # check we can allocate a scanline, unlike double images the scanline
 182     # in the image itself is smaller than a line of i_fcolor
 183     # divide by 2 to get to int range, by 2 for 2 bytes/pixel, by 3 to
 184     # fit the image allocation in, but for the floats to overflow
 185     my $dim4 = $uint_range / 2 / 2 / 3;
 186     my $im_o = Imager->new(xsize=>$dim4, ysize=>1, channels=>1, bits=>16);
 187     is($im_o, undef, "integer overflow check - scanline");
 188     cmp_ok(Imager->errstr, '=~',
 189            qr/integer overflow calculating scanline allocation/,
 190            "check error message");
 191   }
 192 }
 193
 194 { # check the channel mask function
 195
 196   my $im = Imager->new(xsize => 10, ysize=>10, bits=>16);
 197
 198   mask_tests($im, 1.0/65535);
 199 }
 200
 201 { # convert to rgb16
 202   my $im = test_image();
 203   my $im16 = $im->to_rgb16;
 204   print "# check conversion to 16 bit\n";
 205   is($im16->bits, 16, "check bits");
 206   is_image($im, $im16, "check image data matches");
 207 }
 208
 209 { # empty image handling
 210   my $im = Imager->new;
 211   ok($im, "make empty image");
 212   ok(!$im->to_rgb16, "convert empty image to 16-bit");
 213   is($im->errstr, "to_rgb16: empty input image", "check message");
 214 }
 215
 216 { # bounds checks
 217   my $im = Imager->new(xsize => 10, ysize => 10, bits => 16);
 218   image_bounds_checks($im);
 219 }
 220
 221 {
 222   my $im = Imager->new(xsize => 10, ysize => 10, bits => 16, channels => 3);
 223   my @wr_samples = map int(rand 65536), 1..30;
 224   is($im->setsamples('y' => 1, data => \@wr_samples, type => '16bit'),
 225      30, "write 16-bit to OO image")
 226     or print "# ", $im->errstr, "\n";
 227   my @samples;
 228   is($im->getsamples(y => 1, target => \@samples, type => '16bit'),
 229      30, "read 16-bit from OO image")
 230     or print "# ", $im->errstr, "\n";
 231   is_deeply(\@wr_samples, \@samples, "check it matches");
 232 }
 233
 234 my $psamp_outside_error = "Image position outside of image";
 235 { # psamp
 236   print "# psamp\n";
 237   my $imraw = Imager::i_img_16_new(10, 10, 3);
 238   {
 239     is(Imager::i_psamp($imraw, 0, 2, undef, [ 255, 128, 64 ]), 3,
 240        "i_psamp def channels, 3 samples");
 241     is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64,
 242               "check color written");
 243     Imager::i_img_setmask($imraw, 5);
 244     is(Imager::i_psamp($imraw, 1, 3, undef, [ 64, 128, 192 ]), 3,
 245        "i_psamp def channels, 3 samples, masked");
 246     is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 192,
 247               "check color written");
 248     is(Imager::i_psamp($imraw, 1, 7, [ 0, 1, 2 ], [ 64, 128, 192 ]), 3,
 249        "i_psamp channels listed, 3 samples, masked");
 250     is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 192,
 251               "check color written");
 252     Imager::i_img_setmask($imraw, ~0);
 253     is(Imager::i_psamp($imraw, 2, 4, [ 0, 1 ], [ 255, 128, 64, 32 ]), 4,
 254        "i_psamp channels [0, 1], 4 samples");
 255     is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0,
 256               "check first color written");
 257     is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
 258               "check second color written");
 259     is(Imager::i_psamp($imraw, 0, 5, [ 0, 1, 2 ], [ (128, 63, 32) x 10 ]), 30,
 260        "write a full row");
 261     is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
 262               [ (128, 63, 32) x 10 ],
 263               "check full row");
 264     is(Imager::i_psamp($imraw, 8, 8, [ 0, 1, 2 ],
 265                        [ 255, 128, 32, 64, 32, 16, 32, 16, 8 ]),
 266        6, "i_psamp channels [0, 1, 2], 9 samples, but room for 6");
 267   }
 268   { # errors we catch
 269     is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, 3 ], [ 255, 128, 32 ]),
 270        undef, "i_psamp channels [0, 1, 3], 3 samples (invalid channel number)");
 271     is(_get_error(), "No channel 3 in this image",
 272        "check error message");
 273     is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, -1 ], [ 255, 128, 32 ]),
 274        undef, "i_psamp channels [0, 1, -1], 3 samples (invalid channel number)");
 275     is(_get_error(), "No channel -1 in this image",
 276        "check error message");
 277     is(Imager::i_psamp($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
 278        "negative y");
 279     is(_get_error(), $psamp_outside_error,
 280        "check error message");
 281     is(Imager::i_psamp($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
 282        "y overflow");
 283     is(_get_error(), $psamp_outside_error,
 284        "check error message");
 285     is(Imager::i_psamp($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
 286        "negative x");
 287     is(_get_error(), $psamp_outside_error,
 288        "check error message");
 289     is(Imager::i_psamp($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
 290        "x overflow");
 291     is(_get_error(), $psamp_outside_error,
 292        "check error message");
 293   }
 294   print "# end psamp tests\n";
 295 }
 296
 297 { # psampf
 298   print "# psampf\n";
 299   my $imraw = Imager::i_img_16_new(10, 10, 3);
 300   {
 301     is(Imager::i_psampf($imraw, 0, 2, undef, [ 1, 0.5, 0.25 ]), 3,
 302        "i_psampf def channels, 3 samples");
 303     is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 127, 64,
 304               "check color written");
 305     Imager::i_img_setmask($imraw, 5);
 306     is(Imager::i_psampf($imraw, 1, 3, undef, [ 0.25, 0.5, 0.75 ]), 3,
 307        "i_psampf def channels, 3 samples, masked");
 308     is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 191,
 309               "check color written");
 310     is(Imager::i_psampf($imraw, 1, 7, [ 0, 1, 2 ], [ 0.25, 0.5, 0.75 ]), 3,
 311        "i_psampf channels listed, 3 samples, masked");
 312     is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 191,
 313               "check color written");
 314     Imager::i_img_setmask($imraw, ~0);
 315     is(Imager::i_psampf($imraw, 2, 4, [ 0, 1 ], [ 1, 0.5, 0.25, 0.125 ]), 4,
 316        "i_psampf channels [0, 1], 4 samples");
 317     is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 127, 0,
 318               "check first color written");
 319     is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
 320               "check second color written");
 321     is(Imager::i_psampf($imraw, 0, 5, [ 0, 1, 2 ], [ (0.5, 0.25, 0.125) x 10 ]), 30,
 322        "write a full row");
 323     is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
 324               [ (127, 64, 32) x 10 ],
 325               "check full row");
 326     is(Imager::i_psampf($imraw, 8, 8, [ 0, 1, 2 ],
 327                         [ 1.0, 0.5, 0.125, 0.25, 0.125, 0.0625, 0.125, 0, 1 ]),
 328        6, "i_psampf channels [0, 1, 2], 9 samples, but room for 6");
 329   }
 330   { # errors we catch
 331     is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, 3 ], [ 1, 0.5, 0.125 ]),
 332        undef, "i_psampf channels [0, 1, 3], 3 samples (invalid channel number)");
 333     is(_get_error(), "No channel 3 in this image",
 334        "check error message");
 335     is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, -1 ], [ 1, 0.5, 0.125 ]),
 336        undef, "i_psampf channels [0, 1, -1], 3 samples (invalid channel number)");
 337     is(_get_error(), "No channel -1 in this image",
 338        "check error message");
 339     is(Imager::i_psampf($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
 340        "negative y");
 341     is(_get_error(), $psamp_outside_error,
 342        "check error message");
 343     is(Imager::i_psampf($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
 344        "y overflow");
 345     is(_get_error(), $psamp_outside_error,
 346        "check error message");
 347     is(Imager::i_psampf($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
 348        "negative x");
 349     is(_get_error(), $psamp_outside_error,
 350        "check error message");
 351     is(Imager::i_psampf($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
 352        "x overflow");
 353     is(_get_error(), $psamp_outside_error,
 354        "check error message");
 355   }
 356   print "# end psampf tests\n";
 357 }
 358
 359 Imager->close_log;
 360
 361 unless ($ENV{IMAGER_KEEP_FILES}) {
 362   unlink "testout/t021sixteen.log";
 363 }
 364
 365 sub _get_error {
 366   my @errors = Imager::i_errors();
 367   return join(": ", map $_->[0], @errors);
 368 }
 369