report the version of Inline used during testing

[imager.git] / t / t104ppm.t

diff --git a/t/t104ppm.t b/t/t104ppm.t
index 0f9d8581a81032513c9324e5699f4d27fd684ebc..c85d7a9b87d3bec5643528fbbd0eeb651cb55349 100644 (file)
--- a/t/t104ppm.t
+++ b/t/t104ppm.t
@@ -1,20 +1,25 @@
 #!perl -w
 use Imager ':all';
-use Test::More tests => 191;
+use Test::More tests => 205;
 use strict;
-use Imager::Test qw(test_image_raw test_image_16 is_color3 is_color1 is_image);
+use Imager::Test qw(test_image_raw test_image_16 is_color3 is_color1 is_image test_image_named);
+
+$| = 1;
 
 -d "testout" or mkdir "testout";
 
-init_log("testout/t104ppm.log",1);
+Imager->open_log(log => "testout/t104ppm.log");
 
 my $green = i_color_new(0,255,0,255);
 my $blue  = i_color_new(0,0,255,255);
 my $red   = i_color_new(255,0,0,255);
 
+my @files;
+
 my $img    = test_image_raw();
 
 my $fh = openimage(">testout/t104.ppm");
+push @files, "t104.ppm";
 my $IO = Imager::io_new_fd(fileno($fh));
 ok(i_writeppm_wiol($img, $IO), "write pnm low")
   or die "Cannot write testout/t104.ppm\n";
@@ -46,6 +51,7 @@ i_box_filled($gimg, 20, 20, 130, 130, $gray);
 i_box_filled($gimg, 40, 40, 110, 110, $dgray);
 i_arc($gimg, 75, 75, 30, 0, 361, $white);
 
+push @files, "t104_gray.pgm";
 open FH, "> testout/t104_gray.pgm" or die "Cannot create testout/t104_gray.pgm: $!\n";
 binmode FH;
 $IO = Imager::io_new_fd(fileno(FH));
@@ -61,7 +67,8 @@ is(i_img_diff($gimg, $gcmpimg), 0,
    "compare written and read greyscale images");
 
 my $ooim = Imager->new;
-ok($ooim->read(file=>"testimg/simple.pbm"), "read simple pbm, via OO");
+ok($ooim->read(file=>"testimg/simple.pbm"), "read simple pbm, via OO")
+  or print "# ", $ooim->errstr, "\n";
 
 check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 0), 0);
 check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 1), 255);
@@ -225,10 +232,12 @@ is($ooim->tags(name=>'pnm_type'), 1, "check pnm_type tag");
   $im->box(filled => 1, xmin => 8, color => '#FFE0C0');
   $im->box(filled => 1, color => NC(0, 192, 192, 128),
           ymin => 8, xmax => 7);
+  push @files, "t104_alpha.ppm";
   ok($im->write(file=>"testout/t104_alpha.ppm", type=>'pnm'),
      "should succeed writing 4 channel image");
   my $imread = Imager->new;
-  ok($imread->read(file => 'testout/t104_alpha.ppm'), "read it back");
+  ok($imread->read(file => 'testout/t104_alpha.ppm'), "read it back")
+    or print "# ", $imread->errstr, "\n";
   is_color3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0, 
            "check transparent became black");
   is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192,
@@ -254,6 +263,7 @@ is($ooim->tags(name=>'pnm_type'), 1, "check pnm_type tag");
   $im->box(filled => 1, xmin => 8, color => '#FFE0C0');
   $im->box(filled => 1, color => NC(0, 192, 192, 128),
           ymin => 8, xmax => 7);
+  push @files, "t104_alp16.ppm";
   ok($im->write(file=>"testout/t104_alp16.ppm", type=>'pnm', 
                pnm_write_wide_data => 1),
      "should succeed writing 4 channel image");
@@ -493,6 +503,7 @@ print "# check error handling\n";
   $im->box(filled => 1, xmax => 4, color => '#000000');
   $im->box(filled => 1, xmin => 5, color => '#FFFFFF');
   is($im->type, 'paletted', 'mono still paletted');
+  push @files, "t104_mono.pbm";
   ok($im->write(file => 'testout/t104_mono.pbm', type => 'pnm'),
      "save as pbm");
 
@@ -514,6 +525,7 @@ print "# check error handling\n";
   $im->box(filled => 1, xmax => 4, color => '#000000');
   $im->box(filled => 1, xmin => 5, color => '#FFFFFF');
   is($im->type, 'paletted', 'mono still paletted');
+  push @files, "t104_mono2.pbm";
   ok($im->write(file => 'testout/t104_mono2.pbm', type => 'pnm'),
      "save as pbm");
 
@@ -545,10 +557,12 @@ print "# check error handling\n";
   $data = '';
   ok($im->write(data => \$data, type => 'pnm'),
      "write 16-bit image as 16-bit/sample ppm");
+  push @files, "t104_16.ppm";
   $im->write(file=>'testout/t104_16.ppm');
   my $im16 = Imager->new;
   ok($im16->read(data => $data), "read it back");
   is($im16->tags(name => 'pnm_maxval'), 65535, "check maxval");
+  push @files, "t104_16b.ppm";
   $im16->write(file=>'testout/t104_16b.ppm');
   is_image($im, $im16, "check image matches");
 }
@@ -584,6 +598,44 @@ print "# check error handling\n";
   }
 }
 
+{ # image too large handling
+  {
+    ok(!Imager->new(file => "testimg/toowide.ppm", filetype => "pnm"),
+       "fail to read a too wide image");
+    is(Imager->errstr, "unable to read pnm image: could not read image width: integer overflow",
+       "check error message");
+  }
+  {
+    ok(!Imager->new(file => "testimg/tootall.ppm", filetype => "pnm"),
+       "fail to read a too wide image");
+    is(Imager->errstr, "unable to read pnm image: could not read image height: integer overflow",
+       "check error message");
+  }
+}
+
+{ # make sure close is checked for each image type
+  my $fail_close = sub {
+    Imager::i_push_error(0, "synthetic close failure");
+    return 0;
+  };
+
+  for my $type (qw(basic basic16 gray gray16 mono)) {
+    my $im = test_image_named($type);
+    my $io = Imager::io_new_cb(sub { 1 }, undef, undef, $fail_close);
+    ok(!$im->write(io => $io, type => "pnm"),
+       "write $type image with a failing close handler");
+    like($im->errstr, qr/synthetic close failure/,
+        "check error message");
+  }
+}
+
+Imager->close_log;
+
+unless ($ENV{IMAGER_KEEP_FILES}) {
+  unlink "testout/t104ppm.log";
+  unlink map "testout/$_", @files;
+}
+
 sub openimage {
   my $fname = shift;
   local(*FH);