separate tiff and no tiff tests
authorTony Cook <tony@develop=help.com>
Sat, 5 Sep 2009 01:09:28 +0000 (01:09 +0000)
committerTony Cook <tony@develop=help.com>
Sat, 5 Sep 2009 01:09:28 +0000 (01:09 +0000)
MANIFEST
t/t106notiff.t [new file with mode: 0644]
t/t106tiff.t
t/x11rubthru.t

index 6eb56da..297eaab 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -242,7 +242,8 @@ t/t103raw.t
 t/t104ppm.t
 t/t105gif.t            Test gif support
 t/t105nogif.t          Test handling when gif not available
-t/t106tiff.t
+t/t106notiff.t         Test handling when tiff not available
+t/t106tiff.t           Test tiff support
 t/t107bmp.t
 t/t108tga.t
 t/t15color.t
diff --git a/t/t106notiff.t b/t/t106notiff.t
new file mode 100644 (file)
index 0000000..700199c
--- /dev/null
@@ -0,0 +1,18 @@
+#!perl -w
+use strict;
+use Test::More;
+use Imager qw(:all);
+
+i_has_format("tiff")
+  and plan skip_all => "tiff support available - this tests the lack of it";
+
+plan tests => 6;
+
+my $im = Imager->new;
+ok(!$im->read(file=>"testimg/comp4.tif"), "should fail to read tif");
+cmp_ok($im->errstr, '=~', "format 'tiff' not supported", "check no tiff message");
+$im = Imager->new(xsize=>2, ysize=>2);
+ok(!$im->write(file=>"testout/notiff.tif"), "should fail to write tiff");
+cmp_ok($im->errstr, '=~', "format 'tiff' not supported", "check no tiff message");
+ok(!grep($_ eq 'tiff', Imager->read_types), "check tiff not in read types");
+ok(!grep($_ eq 'tiff', Imager->write_types), "check tiff not in write types");
index b4366bf..2d22802 100644 (file)
@@ -1,9 +1,14 @@
 #!perl -w
 use strict;
-use Test::More tests => 213;
+use Test::More;
 use Imager qw(:all);
-use Imager::Test qw(is_image is_image_similar test_image test_image_16 test_image_double);
-$^W=1; # warnings during command-line tests
+use Imager::Test qw(is_image is_image_similar test_image test_image_16 test_image_double test_image_raw);
+
+i_has_format("tiff")
+  or plan skip_all => "no tiff support";
+
+plan tests => 213;
+
 $|=1;  # give us some progress in the test harness
 init_log("testout/t106tiff.log",1);
 
@@ -11,732 +16,708 @@ 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 $img=Imager::ImgRaw::new(150,150,3);
-
-i_box_filled($img,70,25,130,125,$green);
-i_box_filled($img,20,25,80,125,$blue);
-i_arc($img,75,75,30,0,361,$red);
-i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
-
-my $timg = Imager::ImgRaw::new(20, 20, 4);
-my $trans = i_color_new(255, 0, 0, 127);
-i_box_filled($timg, 0, 0, 20, 20, $green);
-i_box_filled($timg, 2, 2, 18, 18, $trans);
-
-SKIP:
-{
-  unless (i_has_format("tiff")) {
-    my $im = Imager->new;
-    ok(!$im->read(file=>"testimg/comp4.tif"), "should fail to read tif");
-    cmp_ok($im->errstr, '=~', "format 'tiff' not supported", "check no tiff message");
-    $im = Imager->new(xsize=>2, ysize=>2);
-    ok(!$im->write(file=>"testout/notiff.tif"), "should fail to write tiff");
-    cmp_ok($im->errstr, '=~', "format 'tiff' not supported", "check no tiff message");
-    ok(!grep($_ eq 'tiff', Imager->read_types), "check tiff not in read types");
-    ok(!grep($_ eq 'tiff', Imager->write_types), "check tiff not in write types");
-    skip("no tiff support", 207);
-  }
+my $img=test_image_raw();
+
+my $ver_string = Imager::i_tiff_libversion();
+ok(my ($full, $major, $minor, $point) = 
+   $ver_string =~ /Version +((\d+)\.(\d+).(\d+))/,
+   "extract library version")
+  or diag("Could not extract from:\n$ver_string");
+diag("libtiff release $full") if $full;
+# make something we can compare
+my $cmp_ver = sprintf("%03d%03d%03d", $major, $minor, $point);
+if ($cmp_ver lt '003007000') {
+  diag("You have an old version of libtiff - $full, some tests will be skipped");
+}
 
-  my $ver_string = Imager::i_tiff_libversion();
-  ok(my ($full, $major, $minor, $point) = 
-     $ver_string =~ /Version +((\d+)\.(\d+).(\d+))/,
-     "extract library version")
-    or diag("Could not extract from:\n$ver_string");
-  diag("libtiff release $full") if $full;
-  # make something we can compare
-  my $cmp_ver = sprintf("%03d%03d%03d", $major, $minor, $point);
-  if ($cmp_ver lt '003007000') {
-    diag("You have an old version of libtiff - $full, some tests will be skipped");
-  }
+Imager::i_tags_add($img, "i_xres", 0, "300", 0);
+Imager::i_tags_add($img, "i_yres", 0, undef, 250);
+# resolutionunit is centimeters
+Imager::i_tags_add($img, "tiff_resolutionunit", 0, undef, 3);
+Imager::i_tags_add($img, "tiff_software", 0, "t106tiff.t", 0);
+open(FH,">testout/t106.tiff") || die "cannot open testout/t106.tiff for writing\n";
+binmode(FH); 
+my $IO = Imager::io_new_fd(fileno(FH));
+ok(i_writetiff_wiol($img, $IO), "write low level")
+  or print "# ", Imager->_error_as_msg, "\n";
+close(FH);
+
+open(FH,"testout/t106.tiff") or die "cannot open testout/t106.tiff\n";
+binmode(FH);
+$IO = Imager::io_new_fd(fileno(FH));
+my $cmpimg = i_readtiff_wiol($IO, -1);
+ok($cmpimg, "read low-level");
+
+close(FH);
+
+print "# tiff average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
+
+ok(!i_img_diff($img, $cmpimg), "compare written and read image");
+
+# check the tags are ok
+my %tags = map { Imager::i_tags_get($cmpimg, $_) }
+  0 .. Imager::i_tags_count($cmpimg) - 1;
+ok(abs($tags{i_xres} - 300) < 0.5, "i_xres in range");
+ok(abs($tags{i_yres} - 250) < 0.5, "i_yres in range");
+is($tags{tiff_resolutionunit}, 3, "tiff_resolutionunit");
+is($tags{tiff_software}, 't106tiff.t', "tiff_software");
+is($tags{tiff_photometric}, 2, "tiff_photometric"); # PHOTOMETRIC_RGB is 2
+is($tags{tiff_bitspersample}, 8, "tiff_bitspersample");
+
+$IO = Imager::io_new_bufchain();
+
+ok(Imager::i_writetiff_wiol($img, $IO), "write to buffer chain");
+my $tiffdata = Imager::io_slurp($IO);
+
+open(FH,"testout/t106.tiff");
+binmode FH;
+my $odata;
+{ local $/;
+  $odata = <FH>;
+}
 
-  Imager::i_tags_add($img, "i_xres", 0, "300", 0);
-  Imager::i_tags_add($img, "i_yres", 0, undef, 250);
-  # resolutionunit is centimeters
-  Imager::i_tags_add($img, "tiff_resolutionunit", 0, undef, 3);
-  Imager::i_tags_add($img, "tiff_software", 0, "t106tiff.t", 0);
-  open(FH,">testout/t106.tiff") || die "cannot open testout/t106.tiff for writing\n";
-  binmode(FH); 
-  my $IO = Imager::io_new_fd(fileno(FH));
-  ok(i_writetiff_wiol($img, $IO), "write low level")
-    or print "# ", Imager->_error_as_msg, "\n";
-  close(FH);
-
-  open(FH,"testout/t106.tiff") or die "cannot open testout/t106.tiff\n";
-  binmode(FH);
-  $IO = Imager::io_new_fd(fileno(FH));
-  my $cmpimg = i_readtiff_wiol($IO, -1);
-  ok($cmpimg, "read low-level");
-
-  close(FH);
-
-  print "# tiff average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
-
-  ok(!i_img_diff($img, $cmpimg), "compare written and read image");
-
-  # check the tags are ok
-  my %tags = map { Imager::i_tags_get($cmpimg, $_) }
-    0 .. Imager::i_tags_count($cmpimg) - 1;
-  ok(abs($tags{i_xres} - 300) < 0.5, "i_xres in range");
-  ok(abs($tags{i_yres} - 250) < 0.5, "i_yres in range");
-  is($tags{tiff_resolutionunit}, 3, "tiff_resolutionunit");
-  is($tags{tiff_software}, 't106tiff.t', "tiff_software");
-  is($tags{tiff_photometric}, 2, "tiff_photometric"); # PHOTOMETRIC_RGB is 2
-  is($tags{tiff_bitspersample}, 8, "tiff_bitspersample");
-
-  $IO = Imager::io_new_bufchain();
-  
-  ok(Imager::i_writetiff_wiol($img, $IO), "write to buffer chain");
-  my $tiffdata = Imager::io_slurp($IO);
-
-  open(FH,"testout/t106.tiff");
-  binmode FH;
-  my $odata;
-  { local $/;
-    $odata = <FH>;
+is($odata, $tiffdata, "same data in file as in memory");
+
+# test Micksa's tiff writer
+# a shortish fax page
+my $faximg = Imager::ImgRaw::new(1728, 2000, 1);
+my $black = i_color_new(0,0,0,255);
+my $white = i_color_new(255,255,255,255);
+# vaguely test-patterny
+i_box_filled($faximg, 0, 0, 1728, 2000, $white);
+i_box_filled($faximg, 100,100,1628, 200, $black);
+my $width = 1;
+my $pos = 100;
+while ($width+$pos < 1628) {
+  i_box_filled($faximg, $pos, 300, $pos+$width-1, 400, $black);
+  $pos += $width + 20;
+  $width += 2;
+}
+open FH, "> testout/t106tiff_fax.tiff"
+  or die "Cannot create testout/t106tiff_fax.tiff: $!";
+binmode FH;
+$IO = Imager::io_new_fd(fileno(FH));
+ok(i_writetiff_wiol_faxable($faximg, $IO, 1), "write faxable, low level");
+close FH;
+
+# test the OO interface
+my $ooim = Imager->new;
+ok($ooim->read(file=>'testout/t106.tiff'), "read OO");
+ok($ooim->write(file=>'testout/t106_oo.tiff'), "write OO");
+
+# OO with the fax image
+my $oofim = Imager->new;
+ok($oofim->read(file=>'testout/t106tiff_fax.tiff'),
+   "read fax OO");
+
+# this should have tags set for the resolution
+%tags = map @$_, $oofim->tags;
+is($tags{i_xres}, 204, "fax i_xres");
+is($tags{i_yres}, 196, "fax i_yres");
+ok(!$tags{i_aspect_only}, "i_aspect_only");
+# resunit_inches
+is($tags{tiff_resolutionunit}, 2, "tiff_resolutionunit");
+is($tags{tiff_bitspersample}, 1, "tiff_bitspersample");
+is($tags{tiff_photometric}, 0, "tiff_photometric");
+
+ok($oofim->write(file=>'testout/t106_oo_fax.tiff', class=>'fax'),
+   "write OO, faxable");
+
+# the following should fail since there's no type and no filename
+my $oodata;
+ok(!$ooim->write(data=>\$oodata), "write with no type and no filename to guess with");
+
+# OO to data
+ok($ooim->write(data=>\$oodata, type=>'tiff'), "write to data")
+  or print "# ",$ooim->errstr, "\n";
+is($oodata, $tiffdata, "check data matches between memory and file");
+
+# make sure we can write non-fine mode
+ok($oofim->write(file=>'testout/t106_oo_faxlo.tiff', class=>'fax', fax_fine=>0), "write OO, fax standard mode");
+
+# paletted reads
+my $img4 = Imager->new;
+ok($img4->read(file=>'testimg/comp4.tif'), "reading 4-bit paletted")
+  or print "# ", $img4->errstr, "\n";
+is($img4->type, 'paletted', "image isn't paletted");
+print "# colors: ", $img4->colorcount,"\n";
+  cmp_ok($img4->colorcount, '<=', 16, "more than 16 colors!");
+#ok($img4->write(file=>'testout/t106_was4.ppm'),
+#   "Cannot write img4");
+# I know I'm using BMP before it's test, but comp4.tif started life 
+# as comp4.bmp
+my $bmp4 = Imager->new;
+ok($bmp4->read(file=>'testimg/comp4.bmp'), "reading 4-bit bmp!");
+my $diff = i_img_diff($img4->{IMG}, $bmp4->{IMG});
+print "# diff $diff\n";
+ok($diff == 0, "image mismatch");
+my $img4t = Imager->new;
+ok($img4t->read(file => 'testimg/comp4t.tif'), "read 4-bit paletted, tiled")
+  or print "# ", $img4t->errstr, "\n";
+is_image($bmp4, $img4t, "check tiled version matches");
+my $img8 = Imager->new;
+ok($img8->read(file=>'testimg/comp8.tif'), "reading 8-bit paletted");
+is($img8->type, 'paletted', "image isn't paletted");
+print "# colors: ", $img8->colorcount,"\n";
+#ok($img8->write(file=>'testout/t106_was8.ppm'),
+#   "Cannot write img8");
+ok($img8->colorcount == 256, "more colors than expected");
+my $bmp8 = Imager->new;
+ok($bmp8->read(file=>'testimg/comp8.bmp'), "reading 8-bit bmp!");
+$diff = i_img_diff($img8->{IMG}, $bmp8->{IMG});
+print "# diff $diff\n";
+ok($diff == 0, "image mismatch");
+my $bad = Imager->new;
+ok($bad->read(file=>'testimg/comp4bad.tif', 
+             allow_incomplete=>1), "bad image not returned");
+ok(scalar $bad->tags(name=>'i_incomplete'), "incomplete tag not set");
+ok($img8->write(file=>'testout/t106_pal8.tif'), "writing 8-bit paletted");
+my $cmp8 = Imager->new;
+ok($cmp8->read(file=>'testout/t106_pal8.tif'),
+   "reading 8-bit paletted");
+#print "# ",$cmp8->errstr,"\n";
+is($cmp8->type, 'paletted', "pal8 isn't paletted");
+is($cmp8->colorcount, 256, "pal8 bad colorcount");
+$diff = i_img_diff($img8->{IMG}, $cmp8->{IMG});
+print "# diff $diff\n";
+ok($diff == 0, "written image doesn't match read");
+ok($img4->write(file=>'testout/t106_pal4.tif'), "writing 4-bit paletted");
+ok(my $cmp4 = Imager->new->read(file=>'testout/t106_pal4.tif'),
+   "reading 4-bit paletted");
+is($cmp4->type, 'paletted', "pal4 isn't paletted");
+is($cmp4->colorcount, 16, "pal4 bad colorcount");
+$diff = i_img_diff($img4->{IMG}, $cmp4->{IMG});
+print "# diff $diff\n";
+ok($diff == 0, "written image doesn't match read");
+
+my $work;
+my $seekpos;
+sub io_writer {
+  my ($what) = @_;
+  if ($seekpos > length $work) {
+    $work .= "\0" x ($seekpos - length $work);
   }
+  substr($work, $seekpos, length $what) = $what;
+  $seekpos += length $what;
   
-  is($odata, $tiffdata, "same data in file as in memory");
-
-  # test Micksa's tiff writer
-  # a shortish fax page
-  my $faximg = Imager::ImgRaw::new(1728, 2000, 1);
-  my $black = i_color_new(0,0,0,255);
-  my $white = i_color_new(255,255,255,255);
-  # vaguely test-patterny
-  i_box_filled($faximg, 0, 0, 1728, 2000, $white);
-  i_box_filled($faximg, 100,100,1628, 200, $black);
-  my $width = 1;
-  my $pos = 100;
-  while ($width+$pos < 1628) {
-    i_box_filled($faximg, $pos, 300, $pos+$width-1, 400, $black);
-    $pos += $width + 20;
-    $width += 2;
-  }
-  open FH, "> testout/t106tiff_fax.tiff"
-    or die "Cannot create testout/t106tiff_fax.tiff: $!";
-  binmode FH;
-  $IO = Imager::io_new_fd(fileno(FH));
-  ok(i_writetiff_wiol_faxable($faximg, $IO, 1), "write faxable, low level");
-  close FH;
-
-  # test the OO interface
-  my $ooim = Imager->new;
-  ok($ooim->read(file=>'testout/t106.tiff'), "read OO");
-  ok($ooim->write(file=>'testout/t106_oo.tiff'), "write OO");
-
-  # OO with the fax image
-  my $oofim = Imager->new;
-  ok($oofim->read(file=>'testout/t106tiff_fax.tiff'),
-     "read fax OO");
-
-  # this should have tags set for the resolution
-  %tags = map @$_, $oofim->tags;
-  is($tags{i_xres}, 204, "fax i_xres");
-  is($tags{i_yres}, 196, "fax i_yres");
-  ok(!$tags{i_aspect_only}, "i_aspect_only");
-  # resunit_inches
-  is($tags{tiff_resolutionunit}, 2, "tiff_resolutionunit");
-  is($tags{tiff_bitspersample}, 1, "tiff_bitspersample");
-  is($tags{tiff_photometric}, 0, "tiff_photometric");
-
-  ok($oofim->write(file=>'testout/t106_oo_fax.tiff', class=>'fax'),
-     "write OO, faxable");
-
-  # the following should fail since there's no type and no filename
-  my $oodata;
-  ok(!$ooim->write(data=>\$oodata), "write with no type and no filename to guess with");
-
-  # OO to data
-  ok($ooim->write(data=>\$oodata, type=>'tiff'), "write to data")
-    or print "# ",$ooim->errstr, "\n";
-  is($oodata, $tiffdata, "check data matches between memory and file");
-
-  # make sure we can write non-fine mode
-  ok($oofim->write(file=>'testout/t106_oo_faxlo.tiff', class=>'fax', fax_fine=>0), "write OO, fax standard mode");
-
-  # paletted reads
-  my $img4 = Imager->new;
-  ok($img4->read(file=>'testimg/comp4.tif'), "reading 4-bit paletted")
-    or print "# ", $img4->errstr, "\n";
-  is($img4->type, 'paletted', "image isn't paletted");
-  print "# colors: ", $img4->colorcount,"\n";
-  cmp_ok($img4->colorcount, '<=', 16, "more than 16 colors!");
-  #ok($img4->write(file=>'testout/t106_was4.ppm'),
-  #   "Cannot write img4");
-  # I know I'm using BMP before it's test, but comp4.tif started life 
-  # as comp4.bmp
-  my $bmp4 = Imager->new;
-  ok($bmp4->read(file=>'testimg/comp4.bmp'), "reading 4-bit bmp!");
-  my $diff = i_img_diff($img4->{IMG}, $bmp4->{IMG});
-  print "# diff $diff\n";
-  ok($diff == 0, "image mismatch");
-  my $img4t = Imager->new;
-  ok($img4t->read(file => 'testimg/comp4t.tif'), "read 4-bit paletted, tiled")
-    or print "# ", $img4t->errstr, "\n";
-  is_image($bmp4, $img4t, "check tiled version matches");
-  my $img8 = Imager->new;
-  ok($img8->read(file=>'testimg/comp8.tif'), "reading 8-bit paletted");
-  is($img8->type, 'paletted', "image isn't paletted");
-  print "# colors: ", $img8->colorcount,"\n";
-  #ok($img8->write(file=>'testout/t106_was8.ppm'),
-  #   "Cannot write img8");
-  ok($img8->colorcount == 256, "more colors than expected");
-  my $bmp8 = Imager->new;
-  ok($bmp8->read(file=>'testimg/comp8.bmp'), "reading 8-bit bmp!");
-  $diff = i_img_diff($img8->{IMG}, $bmp8->{IMG});
-  print "# diff $diff\n";
-  ok($diff == 0, "image mismatch");
-  my $bad = Imager->new;
-  ok($bad->read(file=>'testimg/comp4bad.tif', 
-                allow_incomplete=>1), "bad image not returned");
-  ok(scalar $bad->tags(name=>'i_incomplete'), "incomplete tag not set");
-  ok($img8->write(file=>'testout/t106_pal8.tif'), "writing 8-bit paletted");
-  my $cmp8 = Imager->new;
-  ok($cmp8->read(file=>'testout/t106_pal8.tif'),
-     "reading 8-bit paletted");
-  #print "# ",$cmp8->errstr,"\n";
-  is($cmp8->type, 'paletted', "pal8 isn't paletted");
-  is($cmp8->colorcount, 256, "pal8 bad colorcount");
-  $diff = i_img_diff($img8->{IMG}, $cmp8->{IMG});
-  print "# diff $diff\n";
-  ok($diff == 0, "written image doesn't match read");
-  ok($img4->write(file=>'testout/t106_pal4.tif'), "writing 4-bit paletted");
-  ok(my $cmp4 = Imager->new->read(file=>'testout/t106_pal4.tif'),
-     "reading 4-bit paletted");
-  is($cmp4->type, 'paletted', "pal4 isn't paletted");
-  is($cmp4->colorcount, 16, "pal4 bad colorcount");
-  $diff = i_img_diff($img4->{IMG}, $cmp4->{IMG});
-  print "# diff $diff\n";
-  ok($diff == 0, "written image doesn't match read");
-
-  my $work;
-  my $seekpos;
-  sub io_writer {
-    my ($what) = @_;
-    if ($seekpos > length $work) {
-      $work .= "\0" x ($seekpos - length $work);
-    }
-    substr($work, $seekpos, length $what) = $what;
-    $seekpos += length $what;
-
-    1;
+  1;
+}
+sub io_reader {
+  my ($size, $maxread) = @_;
+  #print "io_reader($size, $maxread) pos $seekpos\n";
+  my $out = substr($work, $seekpos, $maxread);
+  $seekpos += length $out;
+  $out;
+}
+sub io_reader2 {
+  my ($size, $maxread) = @_;
+  #print "io_reader2($size, $maxread) pos $seekpos\n";
+  my $out = substr($work, $seekpos, $size);
+  $seekpos += length $out;
+  $out;
+}
+use IO::Seekable;
+sub io_seeker {
+  my ($offset, $whence) = @_;
+  #print "io_seeker($offset, $whence)\n";
+  if ($whence == SEEK_SET) {
+    $seekpos = $offset;
   }
-  sub io_reader {
-    my ($size, $maxread) = @_;
-    #print "io_reader($size, $maxread) pos $seekpos\n";
-    my $out = substr($work, $seekpos, $maxread);
-    $seekpos += length $out;
-    $out;
+  elsif ($whence == SEEK_CUR) {
+    $seekpos += $offset;
   }
-  sub io_reader2 {
-    my ($size, $maxread) = @_;
-    #print "io_reader2($size, $maxread) pos $seekpos\n";
-    my $out = substr($work, $seekpos, $size);
-    $seekpos += length $out;
-    $out;
-  }
-  use IO::Seekable;
-  sub io_seeker {
-    my ($offset, $whence) = @_;
-    #print "io_seeker($offset, $whence)\n";
-    if ($whence == SEEK_SET) {
-      $seekpos = $offset;
-    }
-    elsif ($whence == SEEK_CUR) {
-      $seekpos += $offset;
-    }
-    else { # SEEK_END
-      $seekpos = length($work) + $offset;
-    }
-    #print "-> $seekpos\n";
-    $seekpos;
-  }
-  my $did_close;
-  sub io_closer {
-    ++$did_close;
+  else { # SEEK_END
+    $seekpos = length($work) + $offset;
   }
+  #print "-> $seekpos\n";
+  $seekpos;
+}
+my $did_close;
+sub io_closer {
+  ++$did_close;
+}
 
-  # read via cb
-  $work = $tiffdata;
-  $seekpos = 0;
-  my $IO2 = Imager::io_new_cb(undef, \&io_reader, \&io_seeker, undef);
-  ok($IO2, "new readcb obj");
-  my $img5 = i_readtiff_wiol($IO2, -1);
-  ok($img5, "read via cb");
-  ok(i_img_diff($img5, $img) == 0, "read from cb diff");
-
-  # read via cb2
-  $work = $tiffdata;
-  $seekpos = 0;
-  my $IO3 = Imager::io_new_cb(undef, \&io_reader2, \&io_seeker, undef);
-  ok($IO3, "new readcb2 obj");
-  my $img6 = i_readtiff_wiol($IO3, -1);
-  ok($img6, "read via cb2");
-  ok(i_img_diff($img6, $img) == 0, "read from cb2 diff");
-
-  # write via cb
-  $work = '';
-  $seekpos = 0;
-  my $IO4 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker,
-                              \&io_closer);
-  ok($IO4, "new writecb obj");
-  ok(i_writetiff_wiol($img, $IO4), "write to cb");
-  is($work, $odata, "write cb match");
-  ok($did_close, "write cb did close");
-  open D1, ">testout/d1.tiff" or die;
-  print D1 $work;
-  close D1;
-  open D2, ">testout/d2.tiff" or die;
-  print D2 $tiffdata;
-  close D2;
-
-  # write via cb2
-  $work = '';
-  $seekpos = 0;
-  $did_close = 0;
-  my $IO5 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker,
-                              \&io_closer, 1);
-  ok($IO5, "new writecb obj 2");
-  ok(i_writetiff_wiol($img, $IO5), "write to cb2");
-  is($work, $odata, "write cb2 match");
-  ok($did_close, "write cb2 did close");
-
-  open D3, ">testout/d3.tiff" or die;
-  print D3 $work;
-  close D3;
-
-  # multi-image write/read
-  my @imgs;
-  push(@imgs, map $ooim->copy(), 1..3);
-  for my $i (0..$#imgs) {
-    $imgs[$i]->addtag(name=>"tiff_pagename", value=>"Page ".($i+1));
-  }
-  my $rc = Imager->write_multi({file=>'testout/t106_multi.tif'}, @imgs);
-  ok($rc, "writing multiple images to tiff");
-  my @out = Imager->read_multi(file=>'testout/t106_multi.tif');
-  ok(@out == @imgs, "reading multiple images from tiff");
-  @out == @imgs or print "# ",scalar @out, " ",Imager->errstr,"\n";
-  for my $i (0..$#imgs) {
-    ok(i_img_diff($imgs[$i]{IMG}, $out[$i]{IMG}) == 0,
-       "comparing image $i");
-    my ($tag) = $out[$i]->tags(name=>'tiff_pagename');
-    is($tag, "Page ".($i+1),
-       "tag doesn't match original image");
-  }
+# read via cb
+$work = $tiffdata;
+$seekpos = 0;
+my $IO2 = Imager::io_new_cb(undef, \&io_reader, \&io_seeker, undef);
+ok($IO2, "new readcb obj");
+my $img5 = i_readtiff_wiol($IO2, -1);
+ok($img5, "read via cb");
+ok(i_img_diff($img5, $img) == 0, "read from cb diff");
+
+# read via cb2
+$work = $tiffdata;
+$seekpos = 0;
+my $IO3 = Imager::io_new_cb(undef, \&io_reader2, \&io_seeker, undef);
+ok($IO3, "new readcb2 obj");
+my $img6 = i_readtiff_wiol($IO3, -1);
+ok($img6, "read via cb2");
+ok(i_img_diff($img6, $img) == 0, "read from cb2 diff");
+
+# write via cb
+$work = '';
+$seekpos = 0;
+my $IO4 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker,
+                           \&io_closer);
+ok($IO4, "new writecb obj");
+ok(i_writetiff_wiol($img, $IO4), "write to cb");
+is($work, $odata, "write cb match");
+ok($did_close, "write cb did close");
+open D1, ">testout/d1.tiff" or die;
+print D1 $work;
+close D1;
+open D2, ">testout/d2.tiff" or die;
+print D2 $tiffdata;
+close D2;
+
+# write via cb2
+$work = '';
+$seekpos = 0;
+$did_close = 0;
+my $IO5 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker,
+                           \&io_closer, 1);
+ok($IO5, "new writecb obj 2");
+ok(i_writetiff_wiol($img, $IO5), "write to cb2");
+is($work, $odata, "write cb2 match");
+ok($did_close, "write cb2 did close");
+
+open D3, ">testout/d3.tiff" or die;
+print D3 $work;
+close D3;
+
+# multi-image write/read
+my @imgs;
+push(@imgs, map $ooim->copy(), 1..3);
+for my $i (0..$#imgs) {
+  $imgs[$i]->addtag(name=>"tiff_pagename", value=>"Page ".($i+1));
+}
+my $rc = Imager->write_multi({file=>'testout/t106_multi.tif'}, @imgs);
+ok($rc, "writing multiple images to tiff");
+my @out = Imager->read_multi(file=>'testout/t106_multi.tif');
+ok(@out == @imgs, "reading multiple images from tiff");
+@out == @imgs or print "# ",scalar @out, " ",Imager->errstr,"\n";
+for my $i (0..$#imgs) {
+  ok(i_img_diff($imgs[$i]{IMG}, $out[$i]{IMG}) == 0,
+     "comparing image $i");
+  my ($tag) = $out[$i]->tags(name=>'tiff_pagename');
+  is($tag, "Page ".($i+1),
+     "tag doesn't match original image");
+}
 
-  # writing even more images to tiff - we weren't handling more than five
-  # correctly on read
-  @imgs = map $ooim->copy(), 1..40;
-  $rc = Imager->write_multi({file=>'testout/t106_multi2.tif'}, @imgs);
-  ok($rc, "writing 40 images to tiff");
-  @out = Imager->read_multi(file=>'testout/t106_multi2.tif');
-  ok(@imgs == @out, "reading 40 images from tiff");
-  # force some allocation activity - helps crash here if it's the problem
-  @out = @imgs = ();
-
-  # multi-image fax files
-  ok(Imager->write_multi({file=>'testout/t106_faxmulti.tiff', class=>'fax'},
-                         $oofim, $oofim), "write multi fax image");
-  @imgs = Imager->read_multi(file=>'testout/t106_faxmulti.tiff');
-  ok(@imgs == 2, "reading multipage fax");
-  ok(Imager::i_img_diff($imgs[0]{IMG}, $oofim->{IMG}) == 0,
-     "compare first fax image");
-  ok(Imager::i_img_diff($imgs[1]{IMG}, $oofim->{IMG}) == 0,
-     "compare second fax image");
-
-  my ($format) = $imgs[0]->tags(name=>'i_format');
-  is($format, 'tiff', "check i_format tag");
-
-  my $unit = $imgs[0]->tags(name=>'tiff_resolutionunit');
-  ok(defined $unit && $unit == 2, "check tiff_resolutionunit tag");
-  my $unitname = $imgs[0]->tags(name=>'tiff_resolutionunit_name');
-  is($unitname, 'inch', "check tiff_resolutionunit_name tag");
-
-  my $warned = Imager->new;
-  ok($warned->read(file=>"testimg/tiffwarn.tif"), "read tiffwarn.tif");
-  my ($warning) = $warned->tags(name=>'i_warning');
-  ok(defined $warning && $warning =~ /unknown field with tag 28712/,
-     "check that warning tag set and correct");
-
-  { # support for reading a given page
-    # first build a simple test image
-    my $im1 = Imager->new(xsize=>50, ysize=>50);
-    $im1->box(filled=>1, color=>$blue);
-    $im1->addtag(name=>'tiff_pagename', value => "Page One");
-    my $im2 = Imager->new(xsize=>60, ysize=>60);
-    $im2->box(filled=>1, color=>$green);
-    $im2->addtag(name=>'tiff_pagename', value=>"Page Two");
-
-    # read second page
-    my $page_file = 'testout/t106_pages.tif';
-    ok(Imager->write_multi({ file=> $page_file}, $im1, $im2),
-       "build simple multiimage for page tests");
-    my $imwork = Imager->new;
-    ok($imwork->read(file=>$page_file, page=>1),
-       "read second page");
-    is($im2->getwidth, $imwork->getwidth, "check width");
-    is($im2->getwidth, $imwork->getheight, "check height");
-    is(i_img_diff($imwork->{IMG}, $im2->{IMG}), 0,
-       "check image content");
-    my ($page_name) = $imwork->tags(name=>'tiff_pagename');
-    is($page_name, 'Page Two', "check tag we set");
-
-    # try an out of range page
-    ok(!$imwork->read(file=>$page_file, page=>2),
-       "check out of range page");
-    is($imwork->errstr, "could not switch to page 2", "check message");
-  }
+# writing even more images to tiff - we weren't handling more than five
+# correctly on read
+@imgs = map $ooim->copy(), 1..40;
+$rc = Imager->write_multi({file=>'testout/t106_multi2.tif'}, @imgs);
+ok($rc, "writing 40 images to tiff");
+@out = Imager->read_multi(file=>'testout/t106_multi2.tif');
+ok(@imgs == @out, "reading 40 images from tiff");
+# force some allocation activity - helps crash here if it's the problem
+@out = @imgs = ();
+
+# multi-image fax files
+ok(Imager->write_multi({file=>'testout/t106_faxmulti.tiff', class=>'fax'},
+                      $oofim, $oofim), "write multi fax image");
+@imgs = Imager->read_multi(file=>'testout/t106_faxmulti.tiff');
+ok(@imgs == 2, "reading multipage fax");
+ok(Imager::i_img_diff($imgs[0]{IMG}, $oofim->{IMG}) == 0,
+   "compare first fax image");
+ok(Imager::i_img_diff($imgs[1]{IMG}, $oofim->{IMG}) == 0,
+   "compare second fax image");
+
+my ($format) = $imgs[0]->tags(name=>'i_format');
+is($format, 'tiff', "check i_format tag");
+
+my $unit = $imgs[0]->tags(name=>'tiff_resolutionunit');
+ok(defined $unit && $unit == 2, "check tiff_resolutionunit tag");
+my $unitname = $imgs[0]->tags(name=>'tiff_resolutionunit_name');
+is($unitname, 'inch', "check tiff_resolutionunit_name tag");
+
+my $warned = Imager->new;
+ok($warned->read(file=>"testimg/tiffwarn.tif"), "read tiffwarn.tif");
+my ($warning) = $warned->tags(name=>'i_warning');
+ok(defined $warning && $warning =~ /unknown field with tag 28712/,
+   "check that warning tag set and correct");
+
+{ # support for reading a given page
+  # first build a simple test image
+  my $im1 = Imager->new(xsize=>50, ysize=>50);
+  $im1->box(filled=>1, color=>$blue);
+  $im1->addtag(name=>'tiff_pagename', value => "Page One");
+  my $im2 = Imager->new(xsize=>60, ysize=>60);
+  $im2->box(filled=>1, color=>$green);
+  $im2->addtag(name=>'tiff_pagename', value=>"Page Two");
+  
+  # read second page
+  my $page_file = 'testout/t106_pages.tif';
+  ok(Imager->write_multi({ file=> $page_file}, $im1, $im2),
+     "build simple multiimage for page tests");
+  my $imwork = Imager->new;
+  ok($imwork->read(file=>$page_file, page=>1),
+     "read second page");
+  is($im2->getwidth, $imwork->getwidth, "check width");
+  is($im2->getwidth, $imwork->getheight, "check height");
+  is(i_img_diff($imwork->{IMG}, $im2->{IMG}), 0,
+     "check image content");
+  my ($page_name) = $imwork->tags(name=>'tiff_pagename');
+  is($page_name, 'Page Two', "check tag we set");
+  
+  # try an out of range page
+  ok(!$imwork->read(file=>$page_file, page=>2),
+     "check out of range page");
+  is($imwork->errstr, "could not switch to page 2", "check message");
+}
 
-  { # test writing returns an error message correctly
-    # open a file read only and try to write to it
-    open TIFF, "> testout/t106_empty.tif" or die;
-    close TIFF;
-    open TIFF, "< testout/t106_empty.tif"
-      or skip "Cannot open testout/t106_empty.tif for reading", 8;
-    binmode TIFF;
-    my $im = Imager->new(xsize=>100, ysize=>100);
-    ok(!$im->write(fh => \*TIFF, type=>'tiff'),
-       "fail to write to read only handle");
-    cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
-          "check error message");
-    ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF }, $im),
-       "fail to write multi to read only handle");
-    cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
-          "check error message");
-    ok(!$im->write(fh => \*TIFF, type=>'tiff', class=>'fax'),
-       "fail to write to read only handle (fax)");
-    cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
-          "check error message");
-    ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF, class=>'fax' }, $im),
-       "fail to write multi to read only handle (fax)");
-    cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
-          "check error message");
-  }
+{ # test writing returns an error message correctly
+  # open a file read only and try to write to it
+  open TIFF, "> testout/t106_empty.tif" or die;
+  close TIFF;
+  open TIFF, "< testout/t106_empty.tif"
+    or skip "Cannot open testout/t106_empty.tif for reading", 8;
+  binmode TIFF;
+  my $im = Imager->new(xsize=>100, ysize=>100);
+  ok(!$im->write(fh => \*TIFF, type=>'tiff'),
+     "fail to write to read only handle");
+  cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
+        "check error message");
+  ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF }, $im),
+     "fail to write multi to read only handle");
+  cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
+        "check error message");
+  ok(!$im->write(fh => \*TIFF, type=>'tiff', class=>'fax'),
+     "fail to write to read only handle (fax)");
+  cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
+        "check error message");
+  ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF, class=>'fax' }, $im),
+     "fail to write multi to read only handle (fax)");
+  cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)',
+        "check error message");
+}
 
-  { # test reading returns an error correctly - use test script as an
-    # invalid TIFF file
-    my $im = Imager->new;
-    ok(!$im->read(file=>'t/t106tiff.t', type=>'tiff'),
-       "fail to read script as image");
-    # we get different magic number values depending on the platform
-    # byte ordering
-    cmp_ok($im->errstr, '=~',
-          "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", 
-          "check error message");
-    my @ims = Imager->read_multi(file =>'t/t106tiff.t', type=>'tiff');
-    ok(!@ims, "fail to read_multi script as image");
-    cmp_ok($im->errstr, '=~',
-          "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", 
-       "check error message");
-  }
+{ # test reading returns an error correctly - use test script as an
+  # invalid TIFF file
+  my $im = Imager->new;
+  ok(!$im->read(file=>'t/t106tiff.t', type=>'tiff'),
+     "fail to read script as image");
+  # we get different magic number values depending on the platform
+  # byte ordering
+  cmp_ok($im->errstr, '=~',
+        "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", 
+        "check error message");
+  my @ims = Imager->read_multi(file =>'t/t106tiff.t', type=>'tiff');
+  ok(!@ims, "fail to read_multi script as image");
+  cmp_ok($im->errstr, '=~',
+        "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", 
+        "check error message");
+}
 
-  { # write_multi to data
-    my $data;
-    my $im = Imager->new(xsize => 50, ysize => 50);
-    ok(Imager->write_multi({ data => \$data, type=>'tiff' }, $im, $im),
-       "write multi to in memory");
-    ok(length $data, "make sure something written");
-    my @im = Imager->read_multi(data => $data);
-    is(@im, 2, "make sure we can read it back");
-    is(Imager::i_img_diff($im[0]{IMG}, $im->{IMG}), 0,
-       "check first image");
-    is(Imager::i_img_diff($im[1]{IMG}, $im->{IMG}), 0,
-       "check second image");
-  }
+{ # write_multi to data
+  my $data;
+  my $im = Imager->new(xsize => 50, ysize => 50);
+  ok(Imager->write_multi({ data => \$data, type=>'tiff' }, $im, $im),
+     "write multi to in memory");
+  ok(length $data, "make sure something written");
+  my @im = Imager->read_multi(data => $data);
+  is(@im, 2, "make sure we can read it back");
+  is(Imager::i_img_diff($im[0]{IMG}, $im->{IMG}), 0,
+     "check first image");
+  is(Imager::i_img_diff($im[1]{IMG}, $im->{IMG}), 0,
+     "check second image");
+}
 
-  { # handling of an alpha channel for various images
-    my $photo_rgb = 2;
-    my $photo_cmyk = 5;
-    my $photo_cielab = 8;
-    my @alpha_images =
-      (
-       [ 'srgb.tif',    3, $photo_rgb,    '003005005' ],
-       [ 'srgba.tif',   4, $photo_rgb,    '003005005' ],
-       [ 'srgbaa.tif',  4, $photo_rgb,    '003005005' ],
-       [ 'scmyk.tif',   3, $photo_cmyk,   '003005005' ],
-       [ 'scmyka.tif',  4, $photo_cmyk,   '003005005' ],
-       [ 'scmykaa.tif', 4, $photo_cmyk,   '003005005' ],
-       [ 'slab.tif',    3, $photo_cielab, '003006001' ],
-      );
-
-    for my $test (@alpha_images) {
-      my ($input, $channels, $photo, $need_ver) = @$test;
-      
-    SKIP: {
-       my $skipped = $channels == 4 ? 4 : 3;
-       $need_ver le $cmp_ver
-         or skip("Your ancient tifflib is buggy/limited for this test", $skipped);
-       my $im = Imager->new;
-       ok($im->read(file => "testimg/$input"),
-          "read alpha test $input")
-         or print "# ", $im->errstr, "\n";
-       is($im->getchannels, $channels, "channels for $input match");
-       is($im->tags(name=>'tiff_photometric'), $photo,
-          "photometric for $input match");
-       $channels == 4
-         or next;
-       my $c = $im->getpixel(x => 0, 'y' => 7);
-       is(($c->rgba)[3], 0, "bottom row should have 0 alpha");
-      }
+{ # handling of an alpha channel for various images
+  my $photo_rgb = 2;
+  my $photo_cmyk = 5;
+  my $photo_cielab = 8;
+  my @alpha_images =
+    (
+     [ 'srgb.tif',    3, $photo_rgb,    '003005005' ],
+     [ 'srgba.tif',   4, $photo_rgb,    '003005005' ],
+     [ 'srgbaa.tif',  4, $photo_rgb,    '003005005' ],
+     [ 'scmyk.tif',   3, $photo_cmyk,   '003005005' ],
+     [ 'scmyka.tif',  4, $photo_cmyk,   '003005005' ],
+     [ 'scmykaa.tif', 4, $photo_cmyk,   '003005005' ],
+     [ 'slab.tif',    3, $photo_cielab, '003006001' ],
+    );
+  
+  for my $test (@alpha_images) {
+    my ($input, $channels, $photo, $need_ver) = @$test;
+    
+  SKIP: {
+      my $skipped = $channels == 4 ? 4 : 3;
+      $need_ver le $cmp_ver
+       or skip("Your ancient tifflib is buggy/limited for this test", $skipped);
+      my $im = Imager->new;
+      ok($im->read(file => "testimg/$input"),
+        "read alpha test $input")
+       or print "# ", $im->errstr, "\n";
+      is($im->getchannels, $channels, "channels for $input match");
+      is($im->tags(name=>'tiff_photometric'), $photo,
+        "photometric for $input match");
+      $channels == 4
+       or next;
+      my $c = $im->getpixel(x => 0, 'y' => 7);
+      is(($c->rgba)[3], 0, "bottom row should have 0 alpha");
     }
   }
+}
 
-  {
-    ok(grep($_ eq 'tiff', Imager->read_types), "check tiff in read types");
-    ok(grep($_ eq 'tiff', Imager->write_types), "check tiff in write types");
-  }
-
-  { # reading tile based images
-    my $im = Imager->new;
-    ok($im->read(file => 'testimg/pengtile.tif'), "read tiled image")
-      or print "# ", $im->errstr, "\n";
-    # compare it
-    my $comp = Imager->new;
-    ok($comp->read(file => 'testimg/penguin-base.ppm'), 'read comparison image');
-    is_image($im, $comp, 'compare them');
-  }
+{
+  ok(grep($_ eq 'tiff', Imager->read_types), "check tiff in read types");
+  ok(grep($_ eq 'tiff', Imager->write_types), "check tiff in write types");
+}
 
- SKIP:
-  { # failing to read tile based images
-    # we grab our tiled image and patch a tile offset to nowhere
-    ok(open(TIFF, '< testimg/pengtile.tif'), 'open pengtile.tif')
-      or skip 'cannot open testimg/pengtile.tif', 4;
+{ # reading tile based images
+  my $im = Imager->new;
+  ok($im->read(file => 'testimg/pengtile.tif'), "read tiled image")
+    or print "# ", $im->errstr, "\n";
+  # compare it
+  my $comp = Imager->new;
+  ok($comp->read(file => 'testimg/penguin-base.ppm'), 'read comparison image');
+  is_image($im, $comp, 'compare them');
+}
 
-    $cmp_ver ge '003005007'
-      or skip("Your ancient tifflib has bad error handling", 4);
-    binmode TIFF;
-    my $data = do { local $/; <TIFF>; };
-    
-    # patch a tile offset
-    substr($data, 0x1AFA0, 4) = pack("H*", "00000200");
-
-    #open PIPE, "| bytedump -a | less" or die;
-    #print PIPE $data;
-    #close PIPE;
-
-    my $allow = Imager->new;
-    ok($allow->read(data => $data, allow_incomplete => 1),
-       "read incomplete tiled");
-    ok($allow->tags(name => 'i_incomplete'), 'i_incomplete set');
-    is($allow->tags(name => 'i_lines_read'), 173, 
-       'check i_lines_read set appropriately');
-
-    my $fail = Imager->new;
-    ok(!$fail->read(data => $data), "read fail tiled");
-  }
+SKIP:
+{ # failing to read tile based images
+  # we grab our tiled image and patch a tile offset to nowhere
+  ok(open(TIFF, '< testimg/pengtile.tif'), 'open pengtile.tif')
+    or skip 'cannot open testimg/pengtile.tif', 4;
+  
+  $cmp_ver ge '003005007'
+    or skip("Your ancient tifflib has bad error handling", 4);
+  binmode TIFF;
+  my $data = do { local $/; <TIFF>; };
+  
+  # patch a tile offset
+  substr($data, 0x1AFA0, 4) = pack("H*", "00000200");
+  
+  #open PIPE, "| bytedump -a | less" or die;
+  #print PIPE $data;
+  #close PIPE;
+  
+  my $allow = Imager->new;
+  ok($allow->read(data => $data, allow_incomplete => 1),
+     "read incomplete tiled");
+  ok($allow->tags(name => 'i_incomplete'), 'i_incomplete set');
+  is($allow->tags(name => 'i_lines_read'), 173, 
+     'check i_lines_read set appropriately');
+  
+  my $fail = Imager->new;
+  ok(!$fail->read(data => $data), "read fail tiled");
+}
 
-  { # read 16-bit/sample
-    my $im16 = Imager->new;
-    ok($im16->read(file => 'testimg/rgb16.tif'), "read 16-bit rgb");
-    is($im16->bits, 16, 'got a 16-bit image');
-    my $im16t = Imager->new;
-    ok($im16t->read(file => 'testimg/rgb16t.tif'), "ready 16-bit rgb tiled");
-    is($im16t->bits, 16, 'got a 16-bit image');
-    is_image($im16, $im16t, 'check they match');
-
-    my $grey16 = Imager->new;
-    ok($grey16->read(file => 'testimg/grey16.tif'), "read 16-bit grey")
-      or print "# ", $grey16->errstr, "\n";
-    is($grey16->bits, 16, 'got a 16-bit image');
-    is($grey16->getchannels, 1, 'and its grey');
-    my $comp16 = $im16->convert(matrix => [ [ 0.299, 0.587, 0.114 ] ]);
-    is_image($grey16, $comp16, 'compare grey to converted');
-
-    my $grey32 = Imager->new;
-    ok($grey32->read(file => 'testimg/grey32.tif'), "read 32-bit grey")
-      or print "# ", $grey32->errstr, "\n";
-    is($grey32->bits, 'double', 'got a double image');
-    is($grey32->getchannels, 2, 'and its grey + alpha');
-    is($grey32->tags(name => 'tiff_bitspersample'), 32, 
-       "check bits per sample");
-    my $base = test_image_double->convert(preset =>'grey')
-      ->convert(preset => 'addalpha');
-    is_image($grey32, $base, 'compare to original');
-  }
+{ # read 16-bit/sample
+  my $im16 = Imager->new;
+  ok($im16->read(file => 'testimg/rgb16.tif'), "read 16-bit rgb");
+  is($im16->bits, 16, 'got a 16-bit image');
+  my $im16t = Imager->new;
+  ok($im16t->read(file => 'testimg/rgb16t.tif'), "ready 16-bit rgb tiled");
+  is($im16t->bits, 16, 'got a 16-bit image');
+  is_image($im16, $im16t, 'check they match');
+  
+  my $grey16 = Imager->new;
+  ok($grey16->read(file => 'testimg/grey16.tif'), "read 16-bit grey")
+    or print "# ", $grey16->errstr, "\n";
+  is($grey16->bits, 16, 'got a 16-bit image');
+  is($grey16->getchannels, 1, 'and its grey');
+  my $comp16 = $im16->convert(matrix => [ [ 0.299, 0.587, 0.114 ] ]);
+  is_image($grey16, $comp16, 'compare grey to converted');
+  
+  my $grey32 = Imager->new;
+  ok($grey32->read(file => 'testimg/grey32.tif'), "read 32-bit grey")
+    or print "# ", $grey32->errstr, "\n";
+  is($grey32->bits, 'double', 'got a double image');
+  is($grey32->getchannels, 2, 'and its grey + alpha');
+  is($grey32->tags(name => 'tiff_bitspersample'), 32, 
+     "check bits per sample");
+  my $base = test_image_double->convert(preset =>'grey')
+    ->convert(preset => 'addalpha');
+  is_image($grey32, $base, 'compare to original');
+}
 
-  { # read 16, 32-bit/sample and compare to the original
-    my $rgba = Imager->new;
-    ok($rgba->read(file => 'testimg/srgba.tif'),
-       "read base rgba image");
-    my $rgba16 = Imager->new;
-    ok($rgba16->read(file => 'testimg/srgba16.tif'),
-       "read 16-bit/sample rgba image");
-    is_image($rgba, $rgba16, "check they match");
-    is($rgba16->bits, 16, 'check we got the right type');
-    
-    my $rgba32 = Imager->new;
-    ok($rgba32->read(file => 'testimg/srgba32.tif'),
-       "read 32-bit/sample rgba image");
-    is_image($rgba, $rgba32, "check they match");
-    is($rgba32->bits, 'double', 'check we got the right type');
-
-    my $cmyka16 = Imager->new;
-    ok($cmyka16->read(file => 'testimg/scmyka16.tif'),
-       "read cmyk 16-bit")
-      or print "# ", $cmyka16->errstr, "\n";
-    is($cmyka16->bits, 16, "check we got the right type");
-    is_image_similar($rgba, $cmyka16, 10, "check image data");
-  }
-  { # read bi-level
-    my $pbm = Imager->new;
-    ok($pbm->read(file => 'testimg/imager.pbm'), "read original pbm");
-    my $tif = Imager->new;
-    ok($tif->read(file => 'testimg/imager.tif'), "read mono tif");
-    is_image($pbm, $tif, "compare them");
-    is($tif->type, 'paletted', 'check image type');
-    is($tif->colorcount, 2, 'check we got a "mono" image');
-  }
+{ # read 16, 32-bit/sample and compare to the original
+  my $rgba = Imager->new;
+  ok($rgba->read(file => 'testimg/srgba.tif'),
+     "read base rgba image");
+  my $rgba16 = Imager->new;
+  ok($rgba16->read(file => 'testimg/srgba16.tif'),
+     "read 16-bit/sample rgba image");
+  is_image($rgba, $rgba16, "check they match");
+  is($rgba16->bits, 16, 'check we got the right type');
+  
+  my $rgba32 = Imager->new;
+  ok($rgba32->read(file => 'testimg/srgba32.tif'),
+     "read 32-bit/sample rgba image");
+  is_image($rgba, $rgba32, "check they match");
+  is($rgba32->bits, 'double', 'check we got the right type');
+  
+  my $cmyka16 = Imager->new;
+  ok($cmyka16->read(file => 'testimg/scmyka16.tif'),
+     "read cmyk 16-bit")
+    or print "# ", $cmyka16->errstr, "\n";
+  is($cmyka16->bits, 16, "check we got the right type");
+  is_image_similar($rgba, $cmyka16, 10, "check image data");
+}
+{ # read bi-level
+  my $pbm = Imager->new;
+  ok($pbm->read(file => 'testimg/imager.pbm'), "read original pbm");
+  my $tif = Imager->new;
+  ok($tif->read(file => 'testimg/imager.tif'), "read mono tif");
+  is_image($pbm, $tif, "compare them");
+  is($tif->type, 'paletted', 'check image type');
+  is($tif->colorcount, 2, 'check we got a "mono" image');
+}
 
-  { # check alpha channels scaled correctly for fallback handler
-    my $im = Imager->new;
-    ok($im->read(file=>'testimg/alpha.tif'), 'read alpha check image');
-    my @colors =
-      (
-       [ 0, 0, 0 ],
-       [ 255, 255, 255 ],
-       [ 127, 0, 127 ],
-       [ 127, 127, 0 ],
-      );
-    my @alphas = ( 255, 191, 127, 63 );
-    my $ok = 1;
-    my $msg = 'alpha check ok';
-  CHECKER:
-    for my $y (0 .. 3) {
-      for my $x (0 .. 3) {
-       my $c = $im->getpixel(x => $x, 'y' => $y);
-       my @c = $c->rgba;
-       my $alpha = pop @c;
-       if ($alpha != $alphas[$y]) {
+{ # check alpha channels scaled correctly for fallback handler
+  my $im = Imager->new;
+  ok($im->read(file=>'testimg/alpha.tif'), 'read alpha check image');
+  my @colors =
+    (
+     [ 0, 0, 0 ],
+     [ 255, 255, 255 ],
+     [ 127, 0, 127 ],
+     [ 127, 127, 0 ],
+    );
+  my @alphas = ( 255, 191, 127, 63 );
+  my $ok = 1;
+  my $msg = 'alpha check ok';
+ CHECKER:
+  for my $y (0 .. 3) {
+    for my $x (0 .. 3) {
+      my $c = $im->getpixel(x => $x, 'y' => $y);
+      my @c = $c->rgba;
+      my $alpha = pop @c;
+      if ($alpha != $alphas[$y]) {
+       $ok = 0;
+       $msg = "($x,$y) alpha mismatch $alpha vs $alphas[$y]";
+       last CHECKER;
+      }
+      my $expect = $colors[$x];
+      for my $ch (0 .. 2) {
+       if (abs($expect->[$ch]-$c[$ch]) > 3) {
          $ok = 0;
-         $msg = "($x,$y) alpha mismatch $alpha vs $alphas[$y]";
+         $msg = "($x,$y)[$ch] color mismatch got $c[$ch] vs expected $expect->[$ch]";
          last CHECKER;
        }
-       my $expect = $colors[$x];
-       for my $ch (0 .. 2) {
-         if (abs($expect->[$ch]-$c[$ch]) > 3) {
-           $ok = 0;
-           $msg = "($x,$y)[$ch] color mismatch got $c[$ch] vs expected $expect->[$ch]";
-           last CHECKER;
-         }
-       }
       }
     }
-    ok($ok, $msg);
   }
+  ok($ok, $msg);
+}
 
-  { # check alpha channels scaled correctly for greyscale
-    my $im = Imager->new;
-    ok($im->read(file=>'testimg/gralpha.tif'), 'read alpha check grey image');
-    my @greys = ( 0, 255, 52, 112 );
-    my @alphas = ( 255, 191, 127, 63 );
-    my $ok = 1;
-    my $msg = 'alpha check ok';
-  CHECKER:
-    for my $y (0 .. 3) {
-      for my $x (0 .. 3) {
-       my $c = $im->getpixel(x => $x, 'y' => $y);
-       my ($grey, $alpha) = $c->rgba;
-       if ($alpha != $alphas[$y]) {
-         $ok = 0;
-         $msg = "($x,$y) alpha mismatch $alpha vs $alphas[$y]";
-         last CHECKER;
-       }
-       if (abs($greys[$x] - $grey) > 3) {
-         $ok = 0;
-         $msg = "($x,$y) grey mismatch $grey vs $greys[$x]";
-         last CHECKER;
-       }
+{ # check alpha channels scaled correctly for greyscale
+  my $im = Imager->new;
+  ok($im->read(file=>'testimg/gralpha.tif'), 'read alpha check grey image');
+  my @greys = ( 0, 255, 52, 112 );
+  my @alphas = ( 255, 191, 127, 63 );
+  my $ok = 1;
+  my $msg = 'alpha check ok';
+ CHECKER:
+  for my $y (0 .. 3) {
+    for my $x (0 .. 3) {
+      my $c = $im->getpixel(x => $x, 'y' => $y);
+      my ($grey, $alpha) = $c->rgba;
+      if ($alpha != $alphas[$y]) {
+       $ok = 0;
+       $msg = "($x,$y) alpha mismatch $alpha vs $alphas[$y]";
+       last CHECKER;
+      }
+      if (abs($greys[$x] - $grey) > 3) {
+       $ok = 0;
+       $msg = "($x,$y) grey mismatch $grey vs $greys[$x]";
+       last CHECKER;
       }
     }
-    ok($ok, $msg);
   }
+  ok($ok, $msg);
+}
 
-  { # 16-bit writes
-    my $orig = test_image_16();
-    my $data;
-    ok($orig->write(data => \$data, type => 'tiff', 
-                   tiff_compression => 'none'), "write 16-bit/sample");
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read it back");
-    is_image($im, $orig, "check read data matches");
-    is($im->tags(name => 'tiff_bitspersample'), 16, "correct bits");
-    is($im->bits, 16, 'check image bits');
-    is($im->tags(name => 'tiff_photometric'), 2, "correct photometric");
+{ # 16-bit writes
+  my $orig = test_image_16();
+  my $data;
+  ok($orig->write(data => \$data, type => 'tiff', 
+                 tiff_compression => 'none'), "write 16-bit/sample");
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read it back");
+  is_image($im, $orig, "check read data matches");
+  is($im->tags(name => 'tiff_bitspersample'), 16, "correct bits");
+  is($im->bits, 16, 'check image bits');
+  is($im->tags(name => 'tiff_photometric'), 2, "correct photometric");
     is($im->tags(name => 'tiff_compression'), 'none', "no compression");
-    is($im->getchannels, 3, 'correct channels');
-  }
+  is($im->getchannels, 3, 'correct channels');
+}
 
-  { # 8-bit writes
-    # and check compression
-    my $compress = Imager::i_tiff_has_compression('lzw') ? 'lzw' : 'packbits';
-    my $orig = test_image()->convert(preset=>'grey')
-      ->convert(preset => 'addalpha');
-    my $data;
-    ok($orig->write(data => \$data, type => 'tiff',
-                   tiff_compression=> $compress),
-       "write 8 bit")
-      or print "# ", $orig->errstr, "\n";
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read it back");
-    is_image($im, $orig, "check read data matches");
-    is($im->tags(name => 'tiff_bitspersample'), 8, 'correct bits');
-    is($im->bits, 8, 'check image bits');
-    is($im->tags(name => 'tiff_photometric'), 1, 'correct photometric');
-    is($im->tags(name => 'tiff_compression'), $compress,
-       "$compress compression");
-    is($im->getchannels, 2, 'correct channels');
-  }
+{ # 8-bit writes
+  # and check compression
+  my $compress = Imager::i_tiff_has_compression('lzw') ? 'lzw' : 'packbits';
+  my $orig = test_image()->convert(preset=>'grey')
+    ->convert(preset => 'addalpha');
+  my $data;
+  ok($orig->write(data => \$data, type => 'tiff',
+                 tiff_compression=> $compress),
+     "write 8 bit")
+    or print "# ", $orig->errstr, "\n";
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read it back");
+  is_image($im, $orig, "check read data matches");
+  is($im->tags(name => 'tiff_bitspersample'), 8, 'correct bits');
+  is($im->bits, 8, 'check image bits');
+  is($im->tags(name => 'tiff_photometric'), 1, 'correct photometric');
+  is($im->tags(name => 'tiff_compression'), $compress,
+     "$compress compression");
+  is($im->getchannels, 2, 'correct channels');
+}
 
-  { # double writes
-    my $orig = test_image_double()->convert(preset=>'addalpha');
-    my $data;
-    ok($orig->write(data => \$data, type => 'tiff', 
-                   tiff_compression => 'none'), 
-       "write 32-bit/sample from double")
-      or print "# ", $orig->errstr, "\n";
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read it back");
-    is_image($im, $orig, "check read data matches");
-    is($im->tags(name => 'tiff_bitspersample'), 32, "correct bits");
-    is($im->bits, 'double', 'check image bits');
-    is($im->tags(name => 'tiff_photometric'), 2, "correct photometric");
-    is($im->tags(name => 'tiff_compression'), 'none', "no compression");
-    is($im->getchannels, 4, 'correct channels');
-  }
+{ # double writes
+  my $orig = test_image_double()->convert(preset=>'addalpha');
+  my $data;
+  ok($orig->write(data => \$data, type => 'tiff', 
+                 tiff_compression => 'none'), 
+     "write 32-bit/sample from double")
+    or print "# ", $orig->errstr, "\n";
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read it back");
+  is_image($im, $orig, "check read data matches");
+  is($im->tags(name => 'tiff_bitspersample'), 32, "correct bits");
+  is($im->bits, 'double', 'check image bits');
+  is($im->tags(name => 'tiff_photometric'), 2, "correct photometric");
+  is($im->tags(name => 'tiff_compression'), 'none', "no compression");
+  is($im->getchannels, 4, 'correct channels');
+}
 
-  { # bilevel
-    my $im = test_image()->convert(preset => 'grey')
-      ->to_paletted(make_colors => 'mono',
-                   translate => 'errdiff');
-    my $faxdata;
-
-    # fax compression is written as miniswhite
-    ok($im->write(data => \$faxdata, type => 'tiff', 
-                 tiff_compression => 'fax3'),
-       "write bilevel fax compressed");
-    my $fax = Imager->new;
-    ok($fax->read(data => $faxdata), "read it back");
-    ok($fax->is_bilevel, "got a bi-level image back");
-    is($fax->tags(name => 'tiff_compression'), 'fax3',
-       "check fax compression used");
-    is_image($fax, $im, "compare to original");
-
-    # other compresion written as minisblack
-    my $packdata;
-    ok($im->write(data => \$packdata, type => 'tiff',
-                 tiff_compression => 'jpeg'),
-       "write bilevel packbits compressed");
-    my $packim = Imager->new;
-    ok($packim->read(data => $packdata), "read it back");
-    ok($packim->is_bilevel, "got a bi-level image back");
-    is($packim->tags(name => 'tiff_compression'), 'packbits',
-       "check fallback compression used");
-    is_image($packim, $im, "compare to original");
-  }
+{ # bilevel
+  my $im = test_image()->convert(preset => 'grey')
+    ->to_paletted(make_colors => 'mono',
+                 translate => 'errdiff');
+  my $faxdata;
+  
+  # fax compression is written as miniswhite
+  ok($im->write(data => \$faxdata, type => 'tiff', 
+               tiff_compression => 'fax3'),
+     "write bilevel fax compressed");
+  my $fax = Imager->new;
+  ok($fax->read(data => $faxdata), "read it back");
+  ok($fax->is_bilevel, "got a bi-level image back");
+  is($fax->tags(name => 'tiff_compression'), 'fax3',
+     "check fax compression used");
+  is_image($fax, $im, "compare to original");
+  
+  # other compresion written as minisblack
+  my $packdata;
+  ok($im->write(data => \$packdata, type => 'tiff',
+               tiff_compression => 'jpeg'),
+     "write bilevel packbits compressed");
+  my $packim = Imager->new;
+  ok($packim->read(data => $packdata), "read it back");
+  ok($packim->is_bilevel, "got a bi-level image back");
+  is($packim->tags(name => 'tiff_compression'), 'packbits',
+     "check fallback compression used");
+  is_image($packim, $im, "compare to original");
+}
 
-  { # fallback handling of tiff
-    is(Imager::i_tiff_has_compression('none'), 1, "can always do uncompresed");
-    is(Imager::i_tiff_has_compression('xxx'), '', "can't do xxx compression");
-  }
+{ # fallback handling of tiff
+  is(Imager::i_tiff_has_compression('none'), 1, "can always do uncompresed");
+  is(Imager::i_tiff_has_compression('xxx'), '', "can't do xxx compression");
 }
 
+
index 7254cb4..5f7836d 100644 (file)
@@ -2,7 +2,12 @@
 use strict;
 use Imager;
 use Imager::Test qw(is_image);
-use Test::More tests => 2;
+use Test::More;
+
+Imager::i_has_format("tiff")
+  or plan skip_all => "no tiff support";
+
+plan tests => 2;
 
 my $dest = Imager->new(xsize => 100, ysize => 100, channels => 4);
 $dest->box(filled => 1, color => '0000FF');