PNG re-work: paletted file writes
[imager.git] / PNG / t / 10png.t
CommitLineData
352c64ed
TC
1#!perl -w
2use strict;
37a9be8e
TC
3use Imager qw(:all);
4use Test::More;
cfb628e2 5use Imager::Test qw(test_image_raw test_image is_image);
1cdc4cbd 6
38eab175
TC
7my $debug_writes = 1;
8
1d7e3124
TC
9-d "testout" or mkdir "testout";
10
9e35eed7 11init_log("testout/t102png.log",1);
1cdc4cbd 12
21c6936b 13plan tests => 187;
37a9be8e 14
a4fa5d5e
TC
15# this loads Imager::File::PNG too
16ok($Imager::formats{"png"}, "must have png format");
1cdc4cbd 17
647508aa
TC
18diag("Library version " . Imager::File::PNG::i_png_lib_version());
19
352c64ed
TC
20my $green = i_color_new(0, 255, 0, 255);
21my $blue = i_color_new(0, 0, 255, 255);
22my $red = i_color_new(255, 0, 0, 255);
1cdc4cbd 23
37a9be8e 24my $img = test_image_raw();
1cdc4cbd
TC
25
26my $timg = Imager::ImgRaw::new(20, 20, 4);
27my $trans = i_color_new(255, 0, 0, 127);
28i_box_filled($timg, 0, 0, 20, 20, $green);
29i_box_filled($timg, 2, 2, 18, 18, $trans);
30
37a9be8e
TC
31Imager::i_tags_add($img, "i_xres", 0, "300", 0);
32Imager::i_tags_add($img, "i_yres", 0, undef, 200);
33# the following confuses the GIMP
34#Imager::i_tags_add($img, "i_aspect_only", 0, undef, 1);
35open(FH,">testout/t102.png") || die "cannot open testout/t102.png for writing\n";
36binmode(FH);
37my $IO = Imager::io_new_fd(fileno(FH));
21c6936b
TC
38ok(Imager::File::PNG::i_writepng_wiol($img, $IO), "write")
39 or diag(Imager->_error_as_msg());
37a9be8e
TC
40close(FH);
41
42open(FH,"testout/t102.png") || die "cannot open testout/t102.png\n";
43binmode(FH);
44$IO = Imager::io_new_fd(fileno(FH));
1d7e3124 45my $cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
37a9be8e
TC
46close(FH);
47ok($cmpimg, "read png");
48
49print "# png average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
50is(i_img_diff($img, $cmpimg), 0, "compare saved and original images");
51
52my %tags = map { Imager::i_tags_get($cmpimg, $_) }
53 0..Imager::i_tags_count($cmpimg) - 1;
54ok(abs($tags{i_xres} - 300) < 1, "i_xres: $tags{i_xres}");
55ok(abs($tags{i_yres} - 200) < 1, "i_yres: $tags{i_yres}");
56is($tags{i_format}, "png", "i_format: $tags{i_format}");
57
58open FH, "> testout/t102_trans.png"
59 or die "Cannot open testout/t102_trans.png: $!";
60binmode FH;
61$IO = Imager::io_new_fd(fileno(FH));
1d7e3124 62ok(Imager::File::PNG::i_writepng_wiol($timg, $IO), "write tranparent");
37a9be8e
TC
63close FH;
64
65open FH,"testout/t102_trans.png"
66 or die "cannot open testout/t102_trans.png\n";
67binmode(FH);
68$IO = Imager::io_new_fd(fileno(FH));
1d7e3124 69$cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
37a9be8e
TC
70ok($cmpimg, "read transparent");
71close(FH);
72
73print "# png average mean square pixel difference: ",sqrt(i_img_diff($timg,$cmpimg))/150*150,"\n";
74is(i_img_diff($timg, $cmpimg), 0, "compare saved and original transparent");
75
76# REGRESSION TEST
77# png.c 1.1 would produce an incorrect image when loading images with
78# less than 8 bits/pixel with a transparent palette entry
79open FH, "< testimg/palette.png"
80 or die "cannot open testimg/palette.png: $!\n";
81binmode FH;
82$IO = Imager::io_new_fd(fileno(FH));
83# 1.1 may segfault here (it does with libefence)
1d7e3124 84my $pimg = Imager::File::PNG::i_readpng_wiol($IO);
37a9be8e
TC
85ok($pimg, "read transparent paletted image");
86close FH;
87
88open FH, "< testimg/palette_out.png"
89 or die "cannot open testimg/palette_out.png: $!\n";
90binmode FH;
91$IO = Imager::io_new_fd(fileno(FH));
1d7e3124 92my $poimg = Imager::File::PNG::i_readpng_wiol($IO);
37a9be8e
TC
93ok($poimg, "read palette_out image");
94close FH;
95if (!is(i_img_diff($pimg, $poimg), 0, "images the same")) {
96 print <<EOS;
d8bbe40d
TC
97# this tests a bug in Imager's png.c v1.1
98# if also tickles a bug in libpng before 1.0.5, so you may need to
99# upgrade libpng
100EOS
37a9be8e
TC
101}
102
103{ # check file limits are checked
104 my $limit_file = "testout/t102.png";
105 ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
106 my $im = Imager->new;
107 ok(!$im->read(file=>$limit_file),
108 "should fail read due to size limits");
109 print "# ",$im->errstr,"\n";
110 like($im->errstr, qr/image width/, "check message");
111
112 ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
113 ok(!$im->read(file=>$limit_file),
114 "should fail read due to size limits");
115 print "# ",$im->errstr,"\n";
116 like($im->errstr, qr/image height/, "check message");
117
118 ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
119 ok($im->read(file=>$limit_file),
120 "should succeed - just inside width limit");
121 ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
122 ok($im->read(file=>$limit_file),
123 "should succeed - just inside height limit");
124
125 # 150 x 150 x 3 channel image uses 67500 bytes
126 ok(Imager->set_file_limits(reset=>1, bytes=>67499),
127 "set bytes limit 67499");
128 ok(!$im->read(file=>$limit_file),
77157728 129 "should fail - too many bytes");
37a9be8e 130 print "# ",$im->errstr,"\n";
77157728 131 like($im->errstr, qr/storage size/, "check error message");
37a9be8e
TC
132 ok(Imager->set_file_limits(reset=>1, bytes=>67500),
133 "set bytes limit 67500");
134 ok($im->read(file=>$limit_file),
135 "should succeed - just inside bytes limit");
136 Imager->set_file_limits(reset=>1);
137}
e7ff1cf7 138
37a9be8e
TC
139{ # check if the read_multi fallback works
140 my @imgs = Imager->read_multi(file => 'testout/t102.png');
141 is(@imgs, 1, "check the image was loaded");
142 is(i_img_diff($img, $imgs[0]), 0, "check image matches");
143
144 # check the write_multi fallback
145 ok(Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
146 @imgs),
147 'test write_multi() callback');
148
149 # check that we fail if we actually write 2
150 ok(!Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
e7ff1cf7 151 @imgs, @imgs),
37a9be8e
TC
152 'test write_multi() callback failure');
153}
f245645a 154
6d5c85a2
TC
155{ # check close failures are handled correctly
156 my $im = test_image();
157 my $fail_close = sub {
158 Imager::i_push_error(0, "synthetic close failure");
9f1597be 159 print "# closecb called\n";
6d5c85a2
TC
160 return 0;
161 };
162 ok(!$im->write(type => "png", callback => sub { 1 },
163 closecb => $fail_close),
164 "check failing close fails");
165 like($im->errstr, qr/synthetic close failure/,
166 "check error message");
167}
168
37a9be8e
TC
169{
170 ok(grep($_ eq 'png', Imager->read_types), "check png in read types");
171 ok(grep($_ eq 'png', Imager->write_types), "check png in write types");
1cdc4cbd 172}
37a9be8e 173
38eab175
TC
174{ # read error reporting
175 my $im = Imager->new;
176 ok(!$im->read(file => "testimg/badcrc.png", type => "png"),
177 "read png with bad CRC chunk should fail");
178 is($im->errstr, "IHDR: CRC error", "check error message");
179}
180
181{ # write error reporting
182 my $im = test_image();
183 ok(!$im->write(type => "png", callback => limited_write(1), buffered => 0),
184 "write limited to 1 byte should fail");
185 is($im->errstr, "Write error on an iolayer source.: limit reached",
186 "check error message");
187}
188
9f1597be
TC
189SKIP:
190{ # https://sourceforge.net/tracker/?func=detail&aid=3314943&group_id=5624&atid=105624
191 # large images
192 Imager::File::PNG::i_png_lib_version() >= 10503
193 or skip("older libpng limits image sizes", 12);
194
195 {
196 my $im = Imager->new(xsize => 1000001, ysize => 1, channels => 1);
197 ok($im, "make a wide image");
198 my $data;
199 ok($im->write(data => \$data, type => "png"),
200 "write wide image as png")
201 or diag("write wide: " . $im->errstr);
202 my $im2 = Imager->new;
203 ok($im->read(data => $data, type => "png"),
204 "read wide image as png")
205 or diag("read wide: " . $im->errstr);
206 is($im->getwidth, 1000001, "check width");
207 is($im->getheight, 1, "check height");
208 is($im->getchannels, 1, "check channels");
209 }
210
211 {
212 my $im = Imager->new(xsize => 1, ysize => 1000001, channels => 1);
213 ok($im, "make a tall image");
214 my $data;
215 ok($im->write(data => \$data, type => "png"),
216 "write wide image as png")
217 or diag("write tall: " . $im->errstr);
218 my $im2 = Imager->new;
219 ok($im->read(data => $data, type => "png"),
220 "read tall image as png")
221 or diag("read tall: " . $im->errstr);
222 is($im->getwidth, 1, "check width");
223 is($im->getheight, 1000001, "check height");
224 is($im->getchannels, 1, "check channels");
225 }
226}
227
6d379e0d
TC
228{ # test grayscale read as greyscale
229 my $im = Imager->new;
230 ok($im->read(file => "testimg/gray.png", type => "png"),
231 "read grayscale");
232 is($im->getchannels, 1, "check channel count");
233 is($im->type, "direct", "check type");
d3f58217 234 is($im->bits, 8, "check bits");
cfb628e2 235 is($im->tags(name => "png_bits"), 8, "check png_bits tag");
963d3602 236 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
6d379e0d
TC
237}
238
239{ # test grayscale + alpha read as greyscale + alpha
240 my $im = Imager->new;
241 ok($im->read(file => "testimg/graya.png", type => "png"),
242 "read grayscale + alpha");
243 is($im->getchannels, 2, "check channel count");
244 is($im->type, "direct", "check type");
d3f58217 245 is($im->bits, 8, "check bits");
cfb628e2 246 is($im->tags(name => "png_bits"), 8, "check png_bits tag");
963d3602 247 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
6d379e0d
TC
248}
249
250{ # test paletted + alpha read as paletted
251 my $im = Imager->new;
252 ok($im->read(file => "testimg/paltrans.png", type => "png"),
253 "read paletted with alpha");
254 is($im->getchannels, 4, "check channel count");
6d379e0d 255 is($im->type, "paletted", "check type");
cfb628e2 256 is($im->tags(name => "png_bits"), 8, "check png_bits tag");
963d3602 257 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
6d379e0d
TC
258}
259
260{ # test paletted read as paletted
261 my $im = Imager->new;
262 ok($im->read(file => "testimg/pal.png", type => "png"),
d3f58217
TC
263 "read paletted");
264 is($im->getchannels, 3, "check channel count");
d3f58217 265 is($im->type, "paletted", "check type");
cfb628e2 266 is($im->tags(name => "png_bits"), 8, "check png_bits tag");
963d3602 267 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
d3f58217
TC
268}
269
270{ # test 16-bit rgb read as 16 bit
271 my $im = Imager->new;
272 ok($im->read(file => "testimg/rgb16.png", type => "png"),
273 "read 16-bit rgb");
6d379e0d 274 is($im->getchannels, 3, "check channel count");
d3f58217 275 is($im->type, "direct", "check type");
963d3602 276 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
d3f58217 277 is($im->bits, 16, "check bits");
cfb628e2 278 is($im->tags(name => "png_bits"), 16, "check png_bits tag");
d3f58217
TC
279}
280
281{ # test 1-bit grey read as mono
282 my $im = Imager->new;
283 ok($im->read(file => "testimg/bilevel.png", type => "png"),
284 "read bilevel png");
285 is($im->getchannels, 1, "check channel count");
963d3602 286 is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
6d379e0d 287 is($im->type, "paletted", "check type");
d3f58217 288 ok($im->is_bilevel, "should be bilevel");
cfb628e2 289 is($im->tags(name => "png_bits"), 1, "check png_bits tag");
cfb628e2
TC
290}
291
292SKIP:
293{ # test interlaced read as interlaced and matches original
294 my $im_i = Imager->new(file => "testimg/rgb8i.png", filetype => "png");
295 ok($im_i, "read interlaced")
296 or skip("Could not read rgb8i.png: " . Imager->errstr, 7);
297 is($im_i->getchannels, 3, "check channel count");
298 is($im_i->type, "direct", "check type");
299 is($im_i->tags(name => "png_bits"), 8, "check png_bits");
a4fa5d5e 300 is($im_i->tags(name => "png_interlace"), 1, "check png_interlace");
cfb628e2
TC
301
302 my $im = Imager->new(file => "testimg/rgb8.png", filetype => "png");
303 ok($im, "read non-interlaced")
304 or skip("Could not read testimg/rgb8.png: " . Imager->errstr, 2);
a4fa5d5e 305 is($im->tags(name => "png_interlace"), 0, "check png_interlace");
cfb628e2 306 is_image($im_i, $im, "compare interlaced and non-interlaced");
6d379e0d
TC
307}
308
a4fa5d5e
TC
309{
310 my @match =
311 (
312 [ "cover.png", "coveri.png" ],
313 [ "cover16.png", "cover16i.png" ],
314 [ "coverpal.png", "coverpali.png" ],
315 );
316 for my $match (@match) {
317 my ($normal, $interlace) = @$match;
318
319 my $n_im = Imager->new(file => "testimg/$normal");
320 ok($n_im, "read $normal")
321 or diag "reading $normal: ", Imager->errstr;
322 my $i_im = Imager->new(file => "testimg/$interlace");
323 ok($i_im, "read $interlace")
324 or diag "reading $interlace: ", Imager->errstr;
325 SKIP:
326 {
327 $n_im && $i_im
328 or skip("Couldn't read a file", 1);
329 is_image($i_im, $n_im, "check normal and interlace files read the same");
330 }
331 }
332}
333
334{
335 my $interlace = 0;
336 for my $name ("cover.png", "coveri.png") {
337 SKIP: {
338 my $im = Imager->new(file => "testimg/$name");
339 ok($im, "read $name")
340 or diag "Failed to read $name: ", Imager->errstr;
341 $im
342 or skip("Couldn't load $name", 5);
343 is($im->tags(name => "i_format"), "png", "$name: i_format");
344 is($im->tags(name => "png_bits"), 8, "$name: png_bits");
345 is($im->tags(name => "png_interlace"), $interlace,
346 "$name: png_interlace");
347 is($im->getchannels, 4, "$name: four channels");
348 is($im->type, "direct", "$name: direct type");
349
350 is_deeply([ $im->getsamples(y => 0, width => 5) ],
351 [ ( 255, 255, 0, 255 ), ( 255, 255, 0, 191 ),
352 ( 255, 255, 0, 127 ), ( 255, 255, 0, 63 ),
353 ( 0, 0, 0, 0) ],
354 "$name: check expected samples row 0");
355 is_deeply([ $im->getsamples(y => 1, width => 5) ],
356 [ ( 255, 0, 0, 255 ), ( 255, 0, 0, 191 ),
357 ( 255, 0, 0, 127 ), ( 255, 0, 0, 63 ),
358 ( 0, 0, 0, 0) ],
359 "$name: check expected samples row 1");
360 }
361 $interlace = 1;
362 }
363}
364
365{
366 my $interlace = 0;
367 for my $name ("coverpal.png", "coverpali.png") {
368 SKIP: {
369 my $im = Imager->new(file => "testimg/$name");
370 ok($im, "read $name")
371 or diag "Failed to read $name: ", Imager->errstr;
372 $im
373 or skip("Couldn't load $name", 5);
374 is($im->tags(name => "i_format"), "png", "$name: i_format");
375 is($im->tags(name => "png_bits"), 4, "$name: png_bits");
376 is($im->tags(name => "png_interlace"), $interlace,
377 "$name: png_interlace");
378 is($im->getchannels, 4, "$name: four channels");
379 is($im->type, "paletted", "$name: paletted type");
380
381 is_deeply([ $im->getsamples(y => 0, width => 5) ],
382 [ ( 255, 255, 0, 255 ), ( 255, 255, 0, 191 ),
383 ( 255, 255, 0, 127 ), ( 255, 255, 0, 63 ),
384 ( 0, 0, 0, 0) ],
385 "$name: check expected samples row 0");
386 is_deeply([ $im->getsamples(y => 1, width => 5) ],
387 [ ( 255, 0, 0, 255 ), ( 255, 0, 0, 191 ),
388 ( 255, 0, 0, 127 ), ( 255, 0, 0, 63 ),
389 ( 0, 0, 0, 0) ],
390 "$name: check expected samples row 1");
391 }
392 $interlace = 1;
393 }
394}
395
396{
397 my $interlace = 0;
398 for my $name ("cover16.png", "cover16i.png") {
399 SKIP: {
400 my $im = Imager->new(file => "testimg/$name");
401 ok($im, "read $name")
402 or diag "Failed to read $name: ", Imager->errstr;
403 $im
404 or skip("Couldn't load $name", 5);
405 is($im->tags(name => "i_format"), "png", "$name: i_format");
406 is($im->tags(name => "png_bits"), 16, "$name: png_bits");
407 is($im->tags(name => "png_interlace"), $interlace,
408 "$name: png_interlace");
409 is($im->getchannels, 4, "$name: four channels");
410 is($im->type, "direct", "$name: direct type");
411
412 is_deeply([ $im->getsamples(y => 0, width => 5, type => "16bit") ],
413 [ ( 65535, 65535, 0, 65535 ), ( 65535, 65535, 0, 49087 ),
414 ( 65535, 65535, 0, 32639 ), ( 65535, 65535, 0, 16191 ),
415 ( 65535, 65535, 65535, 0) ],
416 "$name: check expected samples row 0");
417 is_deeply([ $im->getsamples(y => 1, width => 5, type => "16bit") ],
418 [ ( 65535, 0, 0, 65535 ), ( 65535, 0, 0, 49087 ),
419 ( 65535, 0, 0, 32639 ), ( 65535, 0, 0, 16191 ),
420 ( 65535, 65535, 65535, 0) ],
421 "$name: check expected samples row 1");
422 }
423 $interlace = 1;
424 }
425}
426
21c6936b
TC
427{
428 my $pim = Imager->new(xsize => 5, ysize => 2, channels => 3, type => "paletted");
429 ok($pim, "make a 3 channel paletted image");
430 ok($pim->addcolors(colors => [ qw(#000 #FFF #F00 #0F0 #00f) ]),
431 "add some colors");
432 is($pim->setscanline(y => 0, type => "index",
433 pixels => [ 0, 1, 2, 4, 3 ]), 5, "set some pixels");
434 is($pim->setscanline(y => 1, type => "index",
435 pixels => [ 4, 1, 0, 4, 2 ]), 5, "set some more pixels");
436 ok($pim->write(file => "testout/pal3.png"),
437 "write to testout/pal3.png")
438 or diag("Cannot save testout/pal3.png: ".$pim->errstr);
439 my $in = Imager->new(file => "testout/pal3.png");
440 ok($in, "read it back in")
441 or diag("Cann't read pal3.png back: " . Imager->errstr);
442 is_image($pim, $in, "check it matches");
443 is($in->type, "paletted", "make sure the result is paletted");
444 is($in->tags(name => "png_bits"), 4, "4 bit representation");
445}
446
447{
448 # make sure the code that pushes maxed alpha to the end doesn't break
449 my $pim = Imager->new(xsize => 8, ysize => 2, channels => 4, type => "paletted");
450 ok($pim, "make a 4 channel paletted image");
451 ok($pim->addcolors
452 (colors => [ NC(255, 255, 0, 128), qw(#000 #FFF #F00 #0F0 #00f),
453 NC(0, 0, 0, 0), NC(255, 0, 128, 64) ]),
454 "add some colors");
455 is($pim->setscanline(y => 0, type => "index",
456 pixels => [ 5, 0, 1, 7, 2, 4, 6, 3 ]), 8,
457 "set some pixels");
458 is($pim->setscanline(y => 1, type => "index",
459 pixels => [ 7, 4, 6, 1, 0, 4, 2, 5 ]), 8,
460 "set some more pixels");
461 ok($pim->write(file => "testout/pal4.png"),
462 "write to testout/pal4.png")
463 or diag("Cannot save testout/pal4.png: ".$pim->errstr);
464 my $in = Imager->new(file => "testout/pal4.png");
465 ok($in, "read it back in")
466 or diag("Cann't read pal4.png back: " . Imager->errstr);
467 is_image($pim, $in, "check it matches");
468 is($in->type, "paletted", "make sure the result is paletted");
469 is($in->tags(name => "png_bits"), 4, "4 bit representation");
470}
471
472{
473 my $pim = Imager->new(xsize => 8, ysize => 2, channels => 1, type => "paletted");
474 ok($pim, "make a 1 channel paletted image");
475 ok($pim->addcolors(colors => [ map NC($_, 0, 0), 0, 7, 127, 255 ]),
476 "add some colors^Wgreys");
477 is($pim->setscanline(y => 0, type => "index",
478 pixels => [ 0, 2, 1, 3, 2, 1, 0, 3 ]), 8,
479 "set some pixels");
480 is($pim->setscanline(y => 1, type => "index",
481 pixels => [ 3, 0, 2, 1, 0, 0, 2, 3 ]), 8,
482 "set some more pixels");
483 ok($pim->write(file => "testout/pal1.png"),
484 "write to testout/pal1.png")
485 or diag("Cannot save testout/pal1.png: ".$pim->errstr);
486 my $in = Imager->new(file => "testout/pal1.png");
487 ok($in, "read it back in")
488 or diag("Cann't read pal1.png back: " . Imager->errstr);
489 # PNG doesn't have a paletted greyscale type, so it's written as
490 # paletted color, convert our source image for the comparison
491 my $cmpim = $pim->convert(preset => "rgb");
492 is_image($in, $cmpim, "check it matches");
493 is($in->type, "paletted", "make sure the result is paletted");
494 is($in->tags(name => "png_bits"), 2, "2 bit representation");
495}
496
497{
498 my $pim = Imager->new(xsize => 8, ysize => 2, channels => 2, type => "paletted");
499 ok($pim, "make a 2 channel paletted image");
500 ok($pim->addcolors(colors => [ NC(0, 255, 0), NC(128, 255, 0), NC(255, 255, 0), NC(128, 128, 0) ]),
501 "add some colors^Wgreys")
502 or diag("adding colors: " . $pim->errstr);
503 is($pim->setscanline(y => 0, type => "index",
504 pixels => [ 0, 2, 1, 3, 2, 1, 0, 3 ]), 8,
505 "set some pixels");
506 is($pim->setscanline(y => 1, type => "index",
507 pixels => [ 3, 0, 2, 1, 0, 0, 2, 3 ]), 8,
508 "set some more pixels");
509 ok($pim->write(file => "testout/pal2.png"),
510 "write to testout/pal2.png")
511 or diag("Cannot save testout/pal2.png: ".$pim->errstr);
512 my $in = Imager->new(file => "testout/pal2.png");
513 ok($in, "read it back in")
514 or diag("Cann't read pal1.png back: " . Imager->errstr);
515 # PNG doesn't have a paletted greyscale type, so it's written as
516 # paletted color, convert our source image for the comparison
517 my $cmpim = $pim->convert(preset => "rgb");
518 is_image($in, $cmpim, "check it matches");
519 is($in->type, "paletted", "make sure the result is paletted");
520 is($in->tags(name => "png_bits"), 2, "2 bit representation");
521}
522
38eab175
TC
523sub limited_write {
524 my ($limit) = @_;
525
526 return
527 sub {
528 my ($data) = @_;
529 $limit -= length $data;
530 if ($limit >= 0) {
531 print "# write of ", length $data, " bytes successful ($limit left)\n" if $debug_writes;
532 return 1;
533 }
534 else {
535 print "# write of ", length $data, " bytes failed\n";
536 Imager::i_push_error(0, "limit reached");
537 return;
538 }
539 };
540}
21c6936b 541