#!perl -w
# some of this is tested in t01introvert.t too
use strict;
-use Test::More tests => 128;
-BEGIN { use_ok("Imager"); }
+use Test::More tests => 206;
+BEGIN { use_ok("Imager", ':handy'); }
-use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image);
+use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image is_color4);
Imager->open_log(log => "testout/t023palette.log");
SKIP:
{
skip("don't want to allocate 4Gb", 10)
- unless $Config{intsize} == 4;
+ unless $Config{ptrsize} == 4;
my $uint_range = 256 ** $Config{intsize};
my $dim1 = int(sqrt($uint_range))+1;
# test the scanline allocation check
# divide by 2 to get int range, by 3 so that the image (one byte/pixel)
# doesn't integer overflow, but the scanline of i_color (4/pixel) does
- my $dim4 = $uint_range / 2 / 3;
+ my $dim4 = $uint_range / 3;
my $im_o = Imager->new(xsize=>$dim4, ysize=>1, channels=>3, type=>'paletted');
is($im_o, undef, "integer overflow check - scanline size");
cmp_ok(Imager->errstr, '=~',
isnt_image($palim, $blank, "make sure paletted isn't all black");
}
+{ # check validation of palette entries
+ my $im = Imager->new(xsize => 10, ysize => 10, type => 'paletted');
+ $im->addcolors(colors => [ $black, $red ]);
+ {
+ my $no_croak = eval {
+ $im->setscanline(y => 0, type => 'index', pixels => [ 0, 1 ]);
+ 1;
+ };
+ ok($no_croak, "valid values don't croak");
+ }
+ {
+ my $no_croak = eval {
+ $im->setscanline(y => 0, type => 'index', pixels => pack("C*", 0, 1));
+ 1;
+ };
+ ok($no_croak, "valid values don't croak (packed)");
+ }
+ {
+ my $no_croak = eval {
+ $im->setscanline(y => 0, type => 'index', pixels => [ 2, 255 ]);
+ 1;
+ };
+ ok(!$no_croak, "invalid values do croak");
+ }
+ {
+ my $no_croak = eval {
+ $im->setscanline(y => 0, type => 'index', pixels => pack("C*", 2, 255));
+ 1;
+ };
+ ok(!$no_croak, "invalid values do croak (packed)");
+ }
+}
+
+{
+ my $im = Imager->new(xsize => 1, ysize => 1);
+ my $im_bad = Imager->new;
+ {
+ my @map = Imager->make_palette({});
+ ok(!@map, "make_palette should fail with no images");
+ is(Imager->errstr, "make_palette: supply at least one image",
+ "check error message");
+ }
+ {
+ my @map = Imager->make_palette({}, $im, $im_bad, $im);
+ ok(!@map, "make_palette should fail with an empty image");
+ is(Imager->errstr, "make_palette: image 2 is empty",
+ "check error message");
+ }
+ {
+ my @map = Imager->make_palette({ make_colors => "mono" }, $im);
+ is(@map, 2, "mono should make 2 color palette")
+ or skip("unexpected color count", 2);
+ is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+ is_color4($map[1], 255, 255, 255, 255, "check map[1]");
+ }
+ {
+ my @map = Imager->make_palette({ make_colors => "gray4" }, $im);
+ is(@map, 4, "gray4 should make 4 color palette")
+ or skip("unexpected color count", 4);
+ is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+ is_color4($map[1], 85, 85, 85, 255, "check map[1]");
+ is_color4($map[2], 170, 170, 170, 255, "check map[2]");
+ is_color4($map[3], 255, 255, 255, 255, "check map[3]");
+ }
+ {
+ my @map = Imager->make_palette({ make_colors => "gray16" }, $im);
+ is(@map, 16, "gray16 should make 16 color palette")
+ or skip("unexpected color count", 4);
+ is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+ is_color4($map[1], 17, 17, 17, 255, "check map[1]");
+ is_color4($map[2], 34, 34, 34, 255, "check map[2]");
+ is_color4($map[15], 255, 255, 255, 255, "check map[15]");
+ }
+ {
+ my @map = Imager->make_palette({ make_colors => "gray" }, $im);
+ is(@map, 256, "gray16 should make 256 color palette")
+ or skip("unexpected color count", 4);
+ is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+ is_color4($map[1], 1, 1, 1, 255, "check map[1]");
+ is_color4($map[33], 33, 33, 33, 255, "check map[2]");
+ is_color4($map[255], 255, 255, 255, 255, "check map[15]");
+ }
+}
+
+my $psamp_outside_error = "Image position outside of image";
+{ # psamp
+ print "# psamp\n";
+ my $imraw = Imager::i_img_pal_new(10, 10, 3, 255);
+ my @colors =
+ (
+ NC(0, 0, 0), NC(255, 128, 64), NC(64, 128, 192),
+ NC(64, 0, 192), NC(255, 128, 0), NC(64, 32, 0),
+ NC(128, 63, 32), NC(255, 128, 32), NC(64, 32, 16),
+ );
+ is(Imager::i_addcolors($imraw, @colors), "0 but true",
+ "add colors needed for testing");
+ {
+ is(Imager::i_psamp($imraw, 0, 2, undef, [ 255, 128, 64 ]), 3,
+ "i_psamp def channels, 3 samples");
+ is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64,
+ "check color written");
+ Imager::i_img_setmask($imraw, 5);
+ is(Imager::i_psamp($imraw, 1, 3, undef, [ 64, 128, 192 ]), 3,
+ "i_psamp def channels, 3 samples, masked");
+ is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 192,
+ "check color written");
+ is(Imager::i_psamp($imraw, 1, 7, [ 0, 1, 2 ], [ 64, 128, 192 ]), 3,
+ "i_psamp channels listed, 3 samples, masked");
+ is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 192,
+ "check color written");
+ Imager::i_img_setmask($imraw, ~0);
+ is(Imager::i_psamp($imraw, 2, 4, [ 0, 1 ], [ 255, 128, 64, 32 ]), 4,
+ "i_psamp channels [0, 1], 4 samples");
+ is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0,
+ "check first color written");
+ is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0,
+ "check second color written");
+ is(Imager::i_psamp($imraw, 0, 5, [ 0, 1, 2 ], [ (128, 63, 32) x 10 ]), 30,
+ "write a full row");
+ is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
+ [ (128, 63, 32) x 10 ],
+ "check full row");
+ is(Imager::i_psamp($imraw, 8, 8, [ 0, 1, 2 ],
+ [ 255, 128, 32, 64, 32, 16, 32, 16, 8 ]),
+ 6, "i_psamp channels [0, 1, 2], 9 samples, but room for 6");
+ }
+ { # errors we catch
+ is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, 3 ], [ 255, 128, 32 ]),
+ undef, "i_psamp channels [0, 1, 3], 3 samples (invalid channel number)");
+ is(_get_error(), "No channel 3 in this image",
+ "check error message");
+ is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, -1 ], [ 255, 128, 32 ]),
+ undef, "i_psamp channels [0, 1, -1], 3 samples (invalid channel number)");
+ is(_get_error(), "No channel -1 in this image",
+ "check error message");
+ is(Imager::i_psamp($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
+ "negative y");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psamp($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
+ "y overflow");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psamp($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
+ "negative x");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psamp($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
+ "x overflow");
+ is(_get_error(), $psamp_outside_error, "check message");
+ }
+ ok(Imager::i_img_type($imraw), "still paletted");
+ print "# end psamp tests\n";
+}
+
+{ # psampf
+ print "# psampf\n";
+ my $imraw = Imager::i_img_pal_new(10, 10, 3, 255);
+ my @colors =
+ (
+ NC(0, 0, 0), NC(255, 127, 63), NC(64, 128, 192),
+ NC(63, 0, 191), NC(255, 127, 0), NC(63, 31, 0),
+ NC(127, 63, 31), NC(255, 127, 31), NC(63, 31, 15),
+ );
+ is(Imager::i_addcolors($imraw, @colors), "0 but true",
+ "add colors needed for testing");
+ {
+ is(Imager::i_psampf($imraw, 0, 2, undef, [ 1, 0.5, 0.25 ]), 3,
+ "i_psampf def channels, 3 samples");
+ is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 127, 63,
+ "check color written");
+ Imager::i_img_setmask($imraw, 5);
+ is(Imager::i_psampf($imraw, 1, 3, undef, [ 0.25, 0.5, 0.75 ]), 3,
+ "i_psampf def channels, 3 samples, masked");
+ is_color3(Imager::i_get_pixel($imraw, 1, 3), 63, 0, 191,
+ "check color written");
+ is(Imager::i_psampf($imraw, 1, 7, [ 0, 1, 2 ], [ 0.25, 0.5, 0.75 ]), 3,
+ "i_psampf channels listed, 3 samples, masked");
+ is_color3(Imager::i_get_pixel($imraw, 1, 7), 63, 0, 191,
+ "check color written");
+ Imager::i_img_setmask($imraw, ~0);
+ is(Imager::i_psampf($imraw, 2, 4, [ 0, 1 ], [ 1, 0.5, 0.25, 0.125 ]), 4,
+ "i_psampf channels [0, 1], 4 samples");
+ is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 127, 0,
+ "check first color written");
+ is_color3(Imager::i_get_pixel($imraw, 3, 4), 63, 31, 0,
+ "check second color written");
+ is(Imager::i_psampf($imraw, 0, 5, [ 0, 1, 2 ], [ (0.5, 0.25, 0.125) x 10 ]), 30,
+ "write a full row");
+ is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ],
+ [ (127, 63, 31) x 10 ],
+ "check full row");
+ is(Imager::i_psampf($imraw, 8, 8, [ 0, 1, 2 ],
+ [ 1.0, 0.5, 0.125, 0.25, 0.125, 0.0625, 0.125, 0, 1 ]),
+ 6, "i_psampf channels [0, 1, 2], 9 samples, but room for 6");
+ }
+ { # errors we catch
+ is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, 3 ], [ 1, 0.5, 0.125 ]),
+ undef, "i_psampf channels [0, 1, 3], 3 samples (invalid channel number)");
+ is(_get_error(), "No channel 3 in this image",
+ "check error message");
+ is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, -1 ], [ 1, 0.5, 0.125 ]),
+ undef, "i_psampf channels [0, 1, -1], 3 samples (invalid channel number)");
+ is(_get_error(), "No channel -1 in this image",
+ "check error message");
+ is(Imager::i_psampf($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef,
+ "negative y");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psampf($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef,
+ "y overflow");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psampf($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef,
+ "negative x");
+ is(_get_error(), $psamp_outside_error, "check message");
+ is(Imager::i_psampf($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef,
+ "x overflow");
+ is(_get_error(), $psamp_outside_error, "check message");
+ }
+ ok(Imager::i_img_type($imraw), "still paletted");
+ print "# end psampf tests\n";
+}
+
Imager->close_log;
unless ($ENV{IMAGER_KEEP_FILES}) {
$comment);
}
+sub _get_error {
+ my @errors = Imager::i_errors();
+ return join(": ", map $_->[0], @errors);
+}