#!perl -w
use strict;
-BEGIN { $| = 1; print "1..29\n"; }
-my $loaded;
-END {print "not ok 1\n" unless $loaded;}
-use Imager qw(:all :handy);
-#use Data::Dumper;
-$loaded = 1;
-print "ok 1\n";
-init_log("testout/t021sixteen.t", 1);
+use Test::More tests => 104;
+
+BEGIN { use_ok(Imager=>qw(:all :handy)) }
+
+-d "testout" or mkdir "testout";
+
+init_log("testout/t021sixteen.log", 1);
use Imager::Color::Float;
+use Imager::Test qw(test_image is_image image_bounds_checks test_colorf_gpix
+ test_colorf_glin mask_tests is_color3);
my $im_g = Imager::i_img_16_new(100, 101, 1);
-print Imager::i_img_getchannels($im_g) == 1
- ? "ok 2\n" : "not ok 2 # 1 channel image channel count mismatch\n";
-print Imager::i_img_getmask($im_g) & 1
- ? "ok 3\n" : "not ok 3 # 1 channel image bad mask\n";
-print Imager::i_img_virtual($im_g)
- ? "not ok 4 # 1 channel image thinks it is virtual\n" : "ok 4\n";
-print Imager::i_img_bits($im_g) == 16
- ? "ok 5\n" : "not ok 5 # 1 channel image has bits != 16\n";
-print Imager::i_img_type($im_g) == 0 # direct
- ? "ok 6\n" : "not ok 6 # 1 channel image isn't direct\n";
+is(Imager::i_img_getchannels($im_g), 1, "1 channel image channel count");
+ok(Imager::i_img_getmask($im_g) & 1, "1 channel image mask");
+ok(!Imager::i_img_virtual($im_g), "shouldn't be marked virtual");
+is(Imager::i_img_bits($im_g), 16, "1 channel image has bits == 16");
+is(Imager::i_img_type($im_g), 0, "1 channel image isn't direct");
my @ginfo = i_img_info($im_g);
-print $ginfo[0] == 100
- ? "ok 7\n" : "not ok 7 # 1 channel image width incorrect\n";
-print $ginfo[1] == 101
- ? "ok 8\n" : "not ok 8 # 1 channel image height incorrect\n";
+is($ginfo[0], 100, "1 channel image width");
+is($ginfo[1], 101, "1 channel image height");
undef $im_g;
my $im_rgb = Imager::i_img_16_new(100, 101, 3);
-print Imager::i_img_getchannels($im_rgb) == 3
- ? "ok 9\n" : "not ok 9 # 3 channel image channel count mismatch\n";
-print +(Imager::i_img_getmask($im_rgb) & 7) == 7
- ? "ok 10\n" : "not ok 10 # 3 channel image bad mask\n";
-print Imager::i_img_bits($im_rgb) == 16
- ? "ok 11\n" : "not ok 11 # 3 channel image has bits != 16\n";
-print Imager::i_img_type($im_rgb) == 0 # direct
- ? "ok 12\n" : "not ok 12 # 3 channel image isn't direct\n";
+is(Imager::i_img_getchannels($im_rgb), 3, "3 channel image channel count");
+ok((Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image mask");
+is(Imager::i_img_bits($im_rgb), 16, "3 channel image bits");
+is(Imager::i_img_type($im_rgb), 0, "3 channel image type");
my $redf = NCF(1, 0, 0);
my $greenf = NCF(0, 1, 0);
for my $y (0..101) {
Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
}
-print "ok 13\n";
+pass("fill with red");
# basic sanity
-test_colorf_gpix(14, $im_rgb, 0, 0, $redf);
-test_colorf_gpix(16, $im_rgb, 99, 0, $redf);
-test_colorf_gpix(18, $im_rgb, 0, 100, $redf);
-test_colorf_gpix(20, $im_rgb, 99, 100, $redf);
-test_colorf_glin(22, $im_rgb, 0, 0, ($redf) x 100);
-test_colorf_glin(24, $im_rgb, 0, 100, ($redf) x 100);
+test_colorf_gpix($im_rgb, 0, 0, $redf, 0, "top-left");
+test_colorf_gpix($im_rgb, 99, 0, $redf, 0, "top-right");
+test_colorf_gpix($im_rgb, 0, 100, $redf, 0, "bottom left");
+test_colorf_gpix($im_rgb, 99, 100, $redf, 0, "bottom right");
+test_colorf_glin($im_rgb, 0, 0, [ ($redf) x 100 ], "first line");
+test_colorf_glin($im_rgb, 0, 100, [ ($redf) x 100 ], "last line");
Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
-test_colorf_glin(26, $im_rgb, 0, 1,
- ($redf) x 20, ($greenf) x 60, ($redf) x 20);
+test_colorf_glin($im_rgb, 0, 1,
+ [ ($redf) x 20, ($greenf) x 60, ($redf) x 20 ],
+ "added some green in the middle");
+{
+ my @samples;
+ is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, 0 .. 2), 12,
+ "i_gsamp_bits all channels - count")
+ or print "# ", Imager->_error_as_msg(), "\n";
+ is_deeply(\@samples, [ 65535, 0, 0, 65535, 0, 0,
+ 0, 65535, 0, 0, 65535, 0 ],
+ "check samples retrieved");
+ @samples = ();
+ is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, 0, 2), 8,
+ "i_gsamp_bits some channels - count")
+ or print "# ", Imager->_error_as_msg(), "\n";
+ is_deeply(\@samples, [ 65535, 0, 65535, 0,
+ 0, 0, 0, 0 ],
+ "check samples retrieved");
+ # fail gsamp
+ is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 16, \@samples, 0, 0, 3), undef,
+ "i_gsamp_bits fail bad channel");
+ is(Imager->_error_as_msg(), 'No channel 3 in this image', 'check message');
+
+ is(Imager::i_gsamp_bits($im_rgb, 18, 22, 1, 17, \@samples, 0, 0, 2), 8,
+ "i_gsamp_bits succeed high bits");
+ is($samples[0], 131071, "check correct with high bits");
+
+ # write some samples back
+ my @wr_samples =
+ (
+ 0, 0, 65535,
+ 65535, 0, 0,
+ 0, 65535, 0,
+ 65535, 65535, 0
+ );
+ is(Imager::i_psamp_bits($im_rgb, 18, 2, 16, [ 0 .. 2 ], \@wr_samples),
+ 12, "write 16-bit samples")
+ or print "# ", Imager->_error_as_msg(), "\n";
+ @samples = ();
+ is(Imager::i_gsamp_bits($im_rgb, 18, 22, 2, 16, \@samples, 0, 0 .. 2), 12,
+ "read them back")
+ or print "# ", Imager->_error_as_msg(), "\n";
+ is_deeply(\@samples, \@wr_samples, "check they match");
+ my $c = Imager::i_get_pixel($im_rgb, 18, 2);
+ is_color3($c, 0, 0, 255, "check it write to the right places");
+}
# basic OO tests
-my $oo16img = Imager->new(xsize=>200, ysize=>201, bits=>16)
- or print "not ";
-print "ok 28\n";
-$oo16img->bits == 16 or print "not ";
-print "ok 29\n";
+my $oo16img = Imager->new(xsize=>200, ysize=>201, bits=>16);
+ok($oo16img, "make a 16-bit oo image");
+is($oo16img->bits, 16, "test bits");
+isnt($oo16img->is_bilevel, "should not be considered mono");
+# make sure of error handling
+ok(!Imager->new(xsize=>0, ysize=>1, bits=>16),
+ "fail to create a 0 pixel wide image");
+cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
+ "and correct error message");
+
+ok(!Imager->new(xsize=>1, ysize=>0, bits=>16),
+ "fail to create a 0 pixel high image");
+cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
+ "and correct error message");
+
+ok(!Imager->new(xsize=>-1, ysize=>1, bits=>16),
+ "fail to create a negative width image");
+cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
+ "and correct error message");
+
+ok(!Imager->new(xsize=>1, ysize=>-1, bits=>16),
+ "fail to create a negative height image");
+cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
+ "and correct error message");
+
+ok(!Imager->new(xsize=>-1, ysize=>-1, bits=>16),
+ "fail to create a negative width/height image");
+cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
+ "and correct error message");
+
+ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>0),
+ "fail to create a zero channel image");
+cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
+ "and correct error message");
+ok(!Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>5),
+ "fail to create a five channel image");
+cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
+ "and correct error message");
+
+{
+ # https://rt.cpan.org/Ticket/Display.html?id=8213
+ # check for handling of memory allocation of very large images
+ # only test this on 32-bit machines - on a 64-bit machine it may
+ # result in trying to allocate 4Gb of memory, which is unfriendly at
+ # least and may result in running out of memory, causing a different
+ # type of exit
+ SKIP: {
+ use Config;
+ $Config{intsize} == 4
+ or skip("don't want to allocate 4Gb", 8);
+ my $uint_range = 256 ** $Config{intsize};
+ print "# range $uint_range\n";
+ my $dim1 = int(sqrt($uint_range/2))+1;
+
+ my $im_b = Imager->new(xsize=>$dim1, ysize=>$dim1, channels=>1, bits=>16);
+ is($im_b, undef, "integer overflow check - 1 channel");
+
+ $im_b = Imager->new(xisze=>$dim1, ysize=>1, channels=>1, bits=>16);
+ ok($im_b, "but same width ok");
+ $im_b = Imager->new(xisze=>1, ysize=>$dim1, channels=>1, bits=>16);
+ ok($im_b, "but same height ok");
+ cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
+ "check the error message");
+
+ # do a similar test with a 3 channel image, so we're sure we catch
+ # the same case where the third dimension causes the overflow
+ my $dim3 = int(sqrt($uint_range / 3 / 2))+1;
+
+ $im_b = Imager->new(xsize=>$dim3, ysize=>$dim3, channels=>3, bits=>16);
+ is($im_b, undef, "integer overflow check - 3 channel");
+
+ $im_b = Imager->new(xisze=>$dim3, ysize=>1, channels=>3, bits=>16);
+ ok($im_b, "but same width ok");
+ $im_b = Imager->new(xisze=>1, ysize=>$dim3, channels=>3, bits=>16);
+ ok($im_b, "but same height ok");
+
+ cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
+ "check the error message");
+
+ # check we can allocate a scanline, unlike double images the scanline
+ # in the image itself is smaller than a line of i_fcolor
+ # divide by 2 to get to int range, by 2 for 2 bytes/pixel, by 3 to
+ # fit the image allocation in, but for the floats to overflow
+ my $dim4 = $uint_range / 2 / 2 / 3;
+ my $im_o = Imager->new(xsize=>$dim4, ysize=>1, channels=>1, bits=>16);
+ is($im_o, undef, "integer overflow check - scanline");
+ cmp_ok(Imager->errstr, '=~',
+ qr/integer overflow calculating scanline allocation/,
+ "check error message");
+ }
+}
+{ # check the channel mask function
+
+ my $im = Imager->new(xsize => 10, ysize=>10, bits=>16);
-sub NCF {
- return Imager::Color::Float->new(@_);
+ mask_tests($im, 1.0/65535);
}
-sub test_colorf_gpix {
- my ($test_base, $im, $x, $y, $expected) = @_;
- my $c = Imager::i_gpixf($im, $x, $y);
- $c or print "not ";
- print "ok ",$test_base++,"\n";
- colorf_cmp($c, $expected) == 0 or print "not ";
- print "ok ",$test_base++,"\n";
+{ # convert to rgb16
+ my $im = test_image();
+ my $im16 = $im->to_rgb16;
+ print "# check conversion to 16 bit\n";
+ is($im16->bits, 16, "check bits");
+ is_image($im, $im16, "check image data matches");
}
-sub test_colorf_glin {
- my ($test_base, $im, $x, $y, @pels) = @_;
-
- my @got = Imager::i_glinf($im, $x, $x+@pels, $y);
- @got == @pels or print "not ";
- print "ok ",$test_base++,"\n";
- grep(colorf_cmp($pels[$_], $got[$_]), 0..$#got) and print "not ";
- print "ok ",$test_base++,"\n";
+{ # bounds checks
+ my $im = Imager->new(xsize => 10, ysize => 10, bits => 16);
+ image_bounds_checks($im);
}
-sub colorf_cmp {
- my ($c1, $c2) = @_;
- my @s1 = map { int($_*65535.99) } $c1->rgba;
- my @s2 = map { int($_*65535.99) } $c2->rgba;
-
- # print "# (",join(",", @s1[0..2]),") <=> (",join(",", @s2[0..2]),")\n";
- return $s1[0] <=> $s2[0]
- || $s1[1] <=> $s2[1]
- || $s1[2] <=> $s2[2];
+{
+ my $im = Imager->new(xsize => 10, ysize => 10, bits => 16, channels => 3);
+ my @wr_samples = map int(rand 65536), 1..30;
+ is($im->setsamples('y' => 1, data => \@wr_samples, type => '16bit'),
+ 30, "write 16-bit to OO image")
+ or print "# ", $im->errstr, "\n";
+ my @samples;
+ is($im->getsamples(y => 1, target => \@samples, type => '16bit'),
+ 30, "read 16-bit from OO image")
+ or print "# ", $im->errstr, "\n";
+ is_deeply(\@wr_samples, \@samples, "check it matches");
}
projects / imager.git / blobdiff