PNG/t/10png.t

   1 #!perl -w
   2 use strict;
   3 use Imager qw(:all);
   4 use Test::More;
   5 use Imager::Test qw(test_image_raw test_image is_image);
   6
   7 my $debug_writes = 1;
   8
   9 -d "testout" or mkdir "testout";
  10
  11 init_log("testout/t102png.log",1);
  12
  13 plan tests => 187;
  14
  15 # this loads Imager::File::PNG too
  16 ok($Imager::formats{"png"}, "must have png format");
  17
  18 diag("Library version " . Imager::File::PNG::i_png_lib_version());
  19
  20 my $green  = i_color_new(0,   255, 0,   255);
  21 my $blue   = i_color_new(0,   0,   255, 255);
  22 my $red    = i_color_new(255, 0,   0,   255);
  23
  24 my $img    = test_image_raw();
  25
  26 my $timg = Imager::ImgRaw::new(20, 20, 4);
  27 my $trans = i_color_new(255, 0, 0, 127);
  28 i_box_filled($timg, 0, 0, 20, 20, $green);
  29 i_box_filled($timg, 2, 2, 18, 18, $trans);
  30
  31 Imager::i_tags_add($img, "i_xres", 0, "300", 0);
  32 Imager::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);
  35 open(FH,">testout/t102.png") || die "cannot open testout/t102.png for writing\n";
  36 binmode(FH);
  37 my $IO = Imager::io_new_fd(fileno(FH));
  38 ok(Imager::File::PNG::i_writepng_wiol($img, $IO), "write")
  39   or diag(Imager->_error_as_msg());
  40 close(FH);
  41
  42 open(FH,"testout/t102.png") || die "cannot open testout/t102.png\n";
  43 binmode(FH);
  44 $IO = Imager::io_new_fd(fileno(FH));
  45 my $cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
  46 close(FH);
  47 ok($cmpimg, "read png");
  48
  49 print "# png average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
  50 is(i_img_diff($img, $cmpimg), 0, "compare saved and original images");
  51
  52 my %tags = map { Imager::i_tags_get($cmpimg, $_) }
  53   0..Imager::i_tags_count($cmpimg) - 1;
  54 ok(abs($tags{i_xres} - 300) < 1, "i_xres: $tags{i_xres}");
  55 ok(abs($tags{i_yres} - 200) < 1, "i_yres: $tags{i_yres}");
  56 is($tags{i_format}, "png", "i_format: $tags{i_format}");
  57
  58 open FH, "> testout/t102_trans.png"
  59   or die "Cannot open testout/t102_trans.png: $!";
  60 binmode FH;
  61 $IO = Imager::io_new_fd(fileno(FH));
  62 ok(Imager::File::PNG::i_writepng_wiol($timg, $IO), "write tranparent");
  63 close FH;
  64
  65 open FH,"testout/t102_trans.png"
  66   or die "cannot open testout/t102_trans.png\n";
  67 binmode(FH);
  68 $IO = Imager::io_new_fd(fileno(FH));
  69 $cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
  70 ok($cmpimg, "read transparent");
  71 close(FH);
  72
  73 print "# png average mean square pixel difference: ",sqrt(i_img_diff($timg,$cmpimg))/150*150,"\n";
  74 is(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
  79 open FH, "< testimg/palette.png"
  80   or die "cannot open testimg/palette.png: $!\n";
  81 binmode FH;
  82 $IO = Imager::io_new_fd(fileno(FH));
  83 # 1.1 may segfault here (it does with libefence)
  84 my $pimg = Imager::File::PNG::i_readpng_wiol($IO);
  85 ok($pimg, "read transparent paletted image");
  86 close FH;
  87
  88 open FH, "< testimg/palette_out.png"
  89   or die "cannot open testimg/palette_out.png: $!\n";
  90 binmode FH;
  91 $IO = Imager::io_new_fd(fileno(FH));
  92 my $poimg = Imager::File::PNG::i_readpng_wiol($IO);
  93 ok($poimg, "read palette_out image");
  94 close FH;
  95 if (!is(i_img_diff($pimg, $poimg), 0, "images the same")) {
  96   print <<EOS;
  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
 100 EOS
 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),
 129        "should fail - too many bytes");
 130   print "# ",$im->errstr,"\n";
 131     like($im->errstr, qr/storage size/, "check error message");
 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 }
 138
 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' },
 151                            @imgs, @imgs),
 152      'test write_multi() callback failure');
 153 }
 154
 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");
 159     print "# closecb called\n";
 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
 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");
 172 }
 173
 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
 189 SKIP:
 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
 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");
 234   is($im->bits, 8, "check bits");
 235   is($im->tags(name => "png_bits"), 8, "check png_bits tag");
 236   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 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");
 245   is($im->bits, 8, "check bits");
 246   is($im->tags(name => "png_bits"), 8, "check png_bits tag");
 247   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 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");
 255   is($im->type, "paletted", "check type");
 256   is($im->tags(name => "png_bits"), 8, "check png_bits tag");
 257   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 258 }
 259
 260 { # test paletted read as paletted
 261   my $im = Imager->new;
 262   ok($im->read(file => "testimg/pal.png", type => "png"),
 263      "read paletted");
 264   is($im->getchannels, 3, "check channel count");
 265   is($im->type, "paletted", "check type");
 266   is($im->tags(name => "png_bits"), 8, "check png_bits tag");
 267   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 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");
 274   is($im->getchannels, 3, "check channel count");
 275   is($im->type, "direct", "check type");
 276   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 277   is($im->bits, 16, "check bits");
 278   is($im->tags(name => "png_bits"), 16, "check png_bits tag");
 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");
 286   is($im->tags(name => "png_interlace"), 0, "check png_interlace tag");
 287   is($im->type, "paletted", "check type");
 288   ok($im->is_bilevel, "should be bilevel");
 289   is($im->tags(name => "png_bits"), 1, "check png_bits tag");
 290 }
 291
 292 SKIP:
 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");
 300   is($im_i->tags(name => "png_interlace"), 1, "check png_interlace");
 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);
 305   is($im->tags(name => "png_interlace"), 0, "check png_interlace");
 306   is_image($im_i, $im, "compare interlaced and non-interlaced");
 307 }
 308
 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
 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
 523 sub 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 }
 541