t/t021sixteen.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 85;
   5
   6 BEGIN { use_ok(Imager=>qw(:all :handy)) }
   7
   8 init_log("testout/t021sixteen.log", 1);
   9
  10 require "t/testtools.pl";
  11
  12 use Imager::Color::Float;
  13
  14 my $im_g = Imager::i_img_16_new(100, 101, 1);
  15
  16 is(Imager::i_img_getchannels($im_g), 1, "1 channel image channel count");
  17 ok(Imager::i_img_getmask($im_g) & 1, "1 channel image mask");
  18 ok(!Imager::i_img_virtual($im_g), "shouldn't be marked virtual");
  19 is(Imager::i_img_bits($im_g), 16, "1 channel image has bits == 16");
  20 is(Imager::i_img_type($im_g), 0, "1 channel image isn't direct");
  21
  22 my @ginfo = i_img_info($im_g);
  23 is($ginfo[0], 100, "1 channel image width");
  24 is($ginfo[1], 101, "1 channel image height");
  25
  26 undef $im_g;
  27
  28 my $im_rgb = Imager::i_img_16_new(100, 101, 3);
  29
  30 is(Imager::i_img_getchannels($im_rgb), 3, "3 channel image channel count");
  31 ok((Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image mask");
  32 is(Imager::i_img_bits($im_rgb), 16, "3 channel image bits");
  33 is(Imager::i_img_type($im_rgb), 0, "3 channel image type");
  34
  35 my $redf = NCF(1, 0, 0);
  36 my $greenf = NCF(0, 1, 0);
  37 my $bluef = NCF(0, 0, 1);
  38
  39 # fill with red
  40 for my $y (0..101) {
  41   Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
  42 }
  43 pass("fill with red");
  44 # basic sanity
  45 test_colorf_gpix($im_rgb, 0,  0,   $redf);
  46 test_colorf_gpix($im_rgb, 99, 0,   $redf);
  47 test_colorf_gpix($im_rgb, 0,  100, $redf);
  48 test_colorf_gpix($im_rgb, 99, 100, $redf);
  49 test_colorf_glin($im_rgb, 0,  0,   ($redf) x 100);
  50 test_colorf_glin($im_rgb, 0,  100, ($redf) x 100);
  51
  52 Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
  53 test_colorf_glin($im_rgb, 0, 1,
  54                  ($redf) x 20, ($greenf) x 60, ($redf) x 20);
  55
  56 # basic OO tests
  57 my $oo16img = Imager->new(xsize=>200, ysize=>201, bits=>16);
  58 ok($oo16img, "make a 16-bit oo image");
  59 is($oo16img->bits,  16, "test bits");
  60
  61 # make sure of error handling
  62 ok(!Imager->new(xsize=>0, ysize=>1, bits=>16),
  63     "fail to create a 0 pixel wide image");
  64 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
  65        "and correct error message");
  66
  67 ok(!Imager->new(xsize=>1, ysize=>0, bits=>16),
  68     "fail to create a 0 pixel high image");
  69 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
  70        "and correct error message");
  71
  72 ok(!Imager->new(xsize=>-1, ysize=>1, bits=>16),
  73     "fail to create a negative width image");
  74 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
  75        "and correct error message");
  76
  77 ok(!Imager->new(xsize=>1, ysize=>-1, bits=>16),
  78     "fail to create a negative height image");
  79 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
  80        "and correct error message");
  81
  82 ok(!Imager->new(xsize=>-1, ysize=>-1, bits=>16),
  83     "fail to create a negative width/height image");
  84 cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
  85        "and correct error message");
  86
  87 ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>0),
  88     "fail to create a zero channel image");
  89 cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
  90        "and correct error message");
  91 ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>5),
  92     "fail to create a five channel image");
  93 cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
  94        "and correct error message");
  95
  96 {
  97   # https://rt.cpan.org/Ticket/Display.html?id=8213
  98   # check for handling of memory allocation of very large images
  99   # only test this on 32-bit machines - on a 64-bit machine it may
 100   # result in trying to allocate 4Gb of memory, which is unfriendly at
 101   # least and may result in running out of memory, causing a different
 102   # type of exit
 103  SKIP: {
 104     use Config;
 105     $Config{intsize} == 4
 106       or skip("don't want to allocate 4Gb", 8);
 107     my $uint_range = 256 ** $Config{intsize};
 108     print "# range $uint_range\n";
 109     my $dim1 = int(sqrt($uint_range/2))+1;
 110
 111     my $im_b = Imager->new(xsize=>$dim1, ysize=>$dim1, channels=>1, bits=>16);
 112     is($im_b, undef, "integer overflow check - 1 channel");
 113
 114     $im_b = Imager->new(xisze=>$dim1, ysize=>1, channels=>1, bits=>16);
 115     ok($im_b, "but same width ok");
 116     $im_b = Imager->new(xisze=>1, ysize=>$dim1, channels=>1, bits=>16);
 117     ok($im_b, "but same height ok");
 118     cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
 119            "check the error message");
 120
 121     # do a similar test with a 3 channel image, so we're sure we catch
 122     # the same case where the third dimension causes the overflow
 123     my $dim3 = int(sqrt($uint_range / 3 / 2))+1;
 124
 125     $im_b = Imager->new(xsize=>$dim3, ysize=>$dim3, channels=>3, bits=>16);
 126     is($im_b, undef, "integer overflow check - 3 channel");
 127
 128     $im_b = Imager->new(xisze=>$dim3, ysize=>1, channels=>3, bits=>16);
 129     ok($im_b, "but same width ok");
 130     $im_b = Imager->new(xisze=>1, ysize=>$dim3, channels=>3, bits=>16);
 131     ok($im_b, "but same height ok");
 132
 133     cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
 134            "check the error message");
 135
 136     # check we can allocate a scanline, unlike double images the scanline
 137     # in the image itself is smaller than a line of i_fcolor
 138     # divide by 2 to get to int range, by 2 for 2 bytes/pixel, by 3 to
 139     # fit the image allocation in, but for the floats to overflow
 140     my $dim4 = $uint_range / 2 / 2 / 3;
 141     my $im_o = Imager->new(xsize=>$dim4, ysize=>1, channels=>1, bits=>16);
 142     is($im_o, undef, "integer overflow check - scanline");
 143     cmp_ok(Imager->errstr, '=~',
 144            qr/integer overflow calculating scanline allocation/,
 145            "check error message");
 146   }
 147 }
 148
 149 { # check the channel mask function
 150
 151   my $im = Imager->new(xsize => 10, ysize=>10, bits=>16);
 152
 153   mask_tests($im, 1.0/65535);
 154 }