re-work jpeg tests - move "no jpeg support" tests into t101nojpeg.t to
authorTony Cook <tony@develop=help.com>
Fri, 4 Sep 2009 23:57:59 +0000 (23:57 +0000)
committerTony Cook <tony@develop=help.com>
Fri, 4 Sep 2009 23:57:59 +0000 (23:57 +0000)
avoid stupidly long conditionals

MANIFEST
t/t101jpeg.t
t/t101nojpeg.t [new file with mode: 0644]

index 2832e8a..4605222 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -234,7 +234,8 @@ t/t023palette.t             Test paletted images
 t/t05error.t
 t/t07iolayer.t
 t/t1000files.t          Format independent file tests
-t/t101jpeg.t
+t/t101jpeg.t           Test jpeg support
+t/t101nojpeg.t         Test handling when jpeg not available
 t/t102png.t
 t/t103raw.t
 t/t104ppm.t
index 5279f13..982b410 100644 (file)
 #!perl -w
 use strict;
 use Imager qw(:all);
-use Test::More tests => 94;
-use Imager::Test qw(is_color_close3);
+use Test::More;
+use Imager::Test qw(is_color_close3 test_image_raw);
 
 init_log("testout/t101jpeg.log",1);
 
+i_has_format("jpeg")
+  or plan skip_all => "no jpeg support";
+
+plan tests => 94;
+
 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);
+my $img=test_image_raw();
 my $cmpimg=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]);
+open(FH,">testout/t101.jpg")
+  || die "cannot open testout/t101.jpg for writing\n";
+binmode(FH);
+my $IO = Imager::io_new_fd(fileno(FH));
+ok(i_writejpeg_wiol($img,$IO,30), "write jpeg low level");
+close(FH);
+
+open(FH, "testout/t101.jpg") || die "cannot open testout/t101.jpg\n";
+binmode(FH);
+$IO = Imager::io_new_fd(fileno(FH));
+($cmpimg,undef) = i_readjpeg_wiol($IO);
+close(FH);
+
+my $diff = sqrt(i_img_diff($img,$cmpimg))/150*150;
+print "# jpeg average mean square pixel difference: ",$diff,"\n";
+ok($cmpimg, "read jpeg low level");
+
+ok($diff < 10000, "difference between original and jpeg within bounds");
+
+Imager::i_log_entry("Starting 4\n", 1);
+my $imoo = Imager->new;
+ok($imoo->read(file=>'testout/t101.jpg'), "read jpeg OO");
+
+ok($imoo->write(file=>'testout/t101_oo.jpg'), "write jpeg OO");
+Imager::i_log_entry("Starting 5\n", 1);
+my $oocmp = Imager->new;
+ok($oocmp->read(file=>'testout/t101_oo.jpg'), "read jpeg OO for comparison");
+
+$diff = sqrt(i_img_diff($imoo->{IMG},$oocmp->{IMG}))/150*150;
+print "# OO image difference $diff\n";
+ok($diff < 10000, "difference between original and jpeg within bounds");
+
+# write failure test
+open FH, "< testout/t101.jpg" or die "Cannot open testout/t101.jpg: $!";
+binmode FH;
+ok(!$imoo->write(fd=>fileno(FH), type=>'jpeg'), 'failure handling');
+close FH;
+print "# ",$imoo->errstr,"\n";
+
+# check that the i_format tag is set
+my @fmt = $imoo->tags(name=>'i_format');
+is($fmt[0], 'jpeg', 'i_format tag');
+
+{ # check file limits are checked
+  my $limit_file = "testout/t101.jpg";
+  ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
+  my $im = Imager->new;
+  ok(!$im->read(file=>$limit_file),
+     "should fail read due to size limits");
+  print "# ",$im->errstr,"\n";
+  like($im->errstr, qr/image width/, "check message");
+  
+  ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
+  ok(!$im->read(file=>$limit_file),
+     "should fail read due to size limits");
+  print "# ",$im->errstr,"\n";
+  like($im->errstr, qr/image height/, "check message");
+  
+  ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
+  ok($im->read(file=>$limit_file),
+     "should succeed - just inside width limit");
+  ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
+  ok($im->read(file=>$limit_file),
+     "should succeed - just inside height limit");
+  
+  # 150 x 150 x 3 channel image uses 67500 bytes
+  ok(Imager->set_file_limits(reset=>1, bytes=>67499),
+     "set bytes limit 67499");
+  ok(!$im->read(file=>$limit_file),
+       "should fail - too many bytes");
+  print "# ",$im->errstr,"\n";
+  like($im->errstr, qr/storage size/, "check error message");
+  ok(Imager->set_file_limits(reset=>1, bytes=>67500),
+     "set bytes limit 67500");
+  ok($im->read(file=>$limit_file),
+     "should succeed - just inside bytes limit");
+  Imager->set_file_limits(reset=>1);
+}
 
-i_has_format("jpeg") && print "# has jpeg\n";
-if (!i_has_format("jpeg")) {
-  # previously we'd crash if we tried to save/read an image via the OO
-  # interface when there was no jpeg support
- SKIP:
-  {
-    my $im = Imager->new;
-    ok(!$im->read(file=>"testimg/base.jpg"), "should fail to read jpeg");
-    cmp_ok($im->errstr, '=~', qr/format 'jpeg' not supported/, "check no jpeg message");
-    $im = Imager->new(xsize=>2, ysize=>2);
-    ok(!$im->write(file=>"testout/nojpeg.jpg"), "should fail to write jpeg");
-    cmp_ok($im->errstr, '=~', qr/format 'jpeg' not supported/, "check no jpeg message");
-    ok(!grep($_ eq 'jpeg', Imager->read_types), "check jpeg not in read types");
-    ok(!grep($_ eq 'jpeg', Imager->write_types), "check jpeg not in write types");
-    skip("no jpeg support", 88);
+SKIP:
+{
+  # we don't test them all
+  my %expected_tags =
+    (
+     exif_date_time_original => "2005:11:25 00:00:00",
+     exif_flash => 0,
+     exif_image_description => "Imager Development Notes",
+     exif_make => "Canon",
+     exif_model => "CanoScan LiDE 35",
+     exif_resolution_unit => 2,
+     exif_resolution_unit_name => "inches",
+     exif_user_comment => "        Part of notes from reworking i_arc() and friends.",
+     exif_white_balance => 0,
+     exif_white_balance_name => "Auto white balance",
+    );
+  
+  # exif tests
+  Imager::i_exif_enabled()
+      or skip("no exif support", scalar keys %expected_tags);
+  
+  my $im = Imager->new;
+  $im->read(file=>"testimg/exiftest.jpg")
+    or skip("Could not read test image:".$im->errstr, scalar keys %expected_tags);
+  
+  for my $key (keys %expected_tags) {
+    is($expected_tags{$key}, $im->tags(name => $key),
+       "test value of exif tag $key");
   }
-} else {
-  open(FH,">testout/t101.jpg") || die "cannot open testout/t101.jpg for writing\n";
-  binmode(FH);
-  my $IO = Imager::io_new_fd(fileno(FH));
-  ok(i_writejpeg_wiol($img,$IO,30), "write jpeg low level");
-  close(FH);
-
-  open(FH, "testout/t101.jpg") || die "cannot open testout/t101.jpg\n";
-  binmode(FH);
-  $IO = Imager::io_new_fd(fileno(FH));
-  ($cmpimg,undef) = i_readjpeg_wiol($IO);
-  close(FH);
-
-  my $diff = sqrt(i_img_diff($img,$cmpimg))/150*150;
-  print "# jpeg average mean square pixel difference: ",$diff,"\n";
-  ok($cmpimg, "read jpeg low level");
-
-  ok($diff < 10000, "difference between original and jpeg within bounds");
-
-       Imager::i_log_entry("Starting 4\n", 1);
-  my $imoo = Imager->new;
-  ok($imoo->read(file=>'testout/t101.jpg'), "read jpeg OO");
-
-  ok($imoo->write(file=>'testout/t101_oo.jpg'), "write jpeg OO");
-       Imager::i_log_entry("Starting 5\n", 1);
-  my $oocmp = Imager->new;
-  ok($oocmp->read(file=>'testout/t101_oo.jpg'), "read jpeg OO for comparison");
-
-  $diff = sqrt(i_img_diff($imoo->{IMG},$oocmp->{IMG}))/150*150;
-  print "# OO image difference $diff\n";
-  ok($diff < 10000, "difference between original and jpeg within bounds");
-
-  # write failure test
-  open FH, "< testout/t101.jpg" or die "Cannot open testout/t101.jpg: $!";
-  binmode FH;
-  ok(!$imoo->write(fd=>fileno(FH), type=>'jpeg'), 'failure handling');
-  close FH;
-  print "# ",$imoo->errstr,"\n";
-
-  # check that the i_format tag is set
-  my @fmt = $imoo->tags(name=>'i_format');
-  is($fmt[0], 'jpeg', 'i_format tag');
+}
 
-  { # check file limits are checked
-    my $limit_file = "testout/t101.jpg";
-    ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
-    my $im = Imager->new;
-    ok(!$im->read(file=>$limit_file),
-       "should fail read due to size limits");
-    print "# ",$im->errstr,"\n";
-    like($im->errstr, qr/image width/, "check message");
+{
+  # tests that the density values are set and read correctly
+  # tests jpeg_comment too
+  my @density_tests =
+    (
+     [ 't101cm100.jpg', 
+       { 
+       jpeg_density_unit => 2, 
+       i_xres => 254, 
+       i_yres => 254
+       },
+       { 
+       jpeg_density_unit => 2, 
+       i_xres => 254, 
+       i_yres => 254,
+       i_aspect_only => undef,
+       },
+     ],
+     [
+      't101xonly.jpg',
+      {
+       i_xres => 100,
+      },
+      {
+       i_xres => 100,
+       i_yres => 100,
+       jpeg_density_unit => 1,
+       i_aspect_only => undef,
+      },
+     ],
+     [
+      't101yonly.jpg',
+      {
+       i_yres => 100,
+      },
+      {
+       i_xres => 100,
+       i_yres => 100,
+       jpeg_density_unit => 1,
+       i_aspect_only => undef,
+      },
+     ],
+     [
+      't101asponly.jpg',
+      {
+       i_xres => 50,
+       i_yres => 100,
+       i_aspect_only => 1,
+      },
+      {
+       i_xres => 50,
+       i_yres => 100,
+       i_aspect_only => 1,
+       jpeg_density_unit => 0,
+      },
+     ],
+     [
+      't101com.jpg',
+      {
+       jpeg_comment => 'test comment'
+      },
+     ],
+    );
+  
+  print "# test density tags\n";
+  # I don't care about the content
+  my $base_im = Imager->new(xsize => 10, ysize => 10);
+  for my $test (@density_tests) {
+    my ($filename, $out_tags, $expect_tags) = @$test;
+    $expect_tags ||= $out_tags;
     
-    ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
-    ok(!$im->read(file=>$limit_file),
-       "should fail read due to size limits");
-    print "# ",$im->errstr,"\n";
-    like($im->errstr, qr/image height/, "check message");
+    my $work = $base_im->copy;
+    for my $key (keys %$out_tags) {
+      $work->addtag(name => $key, value => $out_tags->{$key});
+    }
     
-    ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
-    ok($im->read(file=>$limit_file),
-       "should succeed - just inside width limit");
-    ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
-    ok($im->read(file=>$limit_file),
-       "should succeed - just inside height limit");
+    ok($work->write(file=>"testout/$filename", type=>'jpeg'),
+       "save $filename");
     
-    # 150 x 150 x 3 channel image uses 67500 bytes
-    ok(Imager->set_file_limits(reset=>1, bytes=>67499),
-       "set bytes limit 67499");
-    ok(!$im->read(file=>$limit_file),
-       "should fail - too many bytes");
-    print "# ",$im->errstr,"\n";
-    like($im->errstr, qr/storage size/, "check error message");
-    ok(Imager->set_file_limits(reset=>1, bytes=>67500),
-       "set bytes limit 67500");
-    ok($im->read(file=>$limit_file),
-       "should succeed - just inside bytes limit");
-    Imager->set_file_limits(reset=>1);
-  }
-
- SKIP:
-  {
-    # we don't test them all
-    my %expected_tags =
-      (
-       exif_date_time_original => "2005:11:25 00:00:00",
-       exif_flash => 0,
-       exif_image_description => "Imager Development Notes",
-       exif_make => "Canon",
-       exif_model => "CanoScan LiDE 35",
-       exif_resolution_unit => 2,
-       exif_resolution_unit_name => "inches",
-       exif_user_comment => "        Part of notes from reworking i_arc() and friends.",
-       exif_white_balance => 0,
-       exif_white_balance_name => "Auto white balance",
-      );
-
-    # exif tests
-    Imager::i_exif_enabled()
-       or skip("no exif support", scalar keys %expected_tags);
-
-    my $im = Imager->new;
-    $im->read(file=>"testimg/exiftest.jpg")
-      or skip("Could not read test image:".$im->errstr, scalar keys %expected_tags);
-
-    for my $key (keys %expected_tags) {
-      is($expected_tags{$key}, $im->tags(name => $key),
-        "test value of exif tag $key");
-    }
-  }
-
-  {
-    # tests that the density values are set and read correctly
-    # tests jpeg_comment too
-    my @density_tests =
-      (
-       [ 't101cm100.jpg', 
-        { 
-         jpeg_density_unit => 2, 
-         i_xres => 254, 
-         i_yres => 254
-        },
-        { 
-         jpeg_density_unit => 2, 
-         i_xres => 254, 
-         i_yres => 254,
-         i_aspect_only => undef,
-        },
-       ],
-       [
-       't101xonly.jpg',
-       {
-        i_xres => 100,
-       },
-       {
-        i_xres => 100,
-        i_yres => 100,
-        jpeg_density_unit => 1,
-        i_aspect_only => undef,
-       },
-       ],
-       [
-       't101yonly.jpg',
-       {
-        i_yres => 100,
-       },
-       {
-        i_xres => 100,
-        i_yres => 100,
-        jpeg_density_unit => 1,
-        i_aspect_only => undef,
-       },
-       ],
-       [
-       't101asponly.jpg',
-       {
-        i_xres => 50,
-        i_yres => 100,
-        i_aspect_only => 1,
-       },
-       {
-        i_xres => 50,
-        i_yres => 100,
-        i_aspect_only => 1,
-        jpeg_density_unit => 0,
-       },
-       ],
-       [
-       't101com.jpg',
-       {
-        jpeg_comment => 'test comment'
-       },
-       ],
-      );
-
-    print "# test density tags\n";
-    # I don't care about the content
-    my $base_im = Imager->new(xsize => 10, ysize => 10);
-    for my $test (@density_tests) {
-      my ($filename, $out_tags, $expect_tags) = @$test;
-      $expect_tags ||= $out_tags;
-
-      my $work = $base_im->copy;
-      for my $key (keys %$out_tags) {
-       $work->addtag(name => $key, value => $out_tags->{$key});
-      }
-
-      ok($work->write(file=>"testout/$filename", type=>'jpeg'),
-        "save $filename");
-      
-      my $check = Imager->new;
-      ok($check->read(file=> "testout/$filename"),
-        "read $filename");
-
-      my %tags;
-      for my $key (keys %$expect_tags) {
-       $tags{$key} = $check->tags(name=>$key);
-      }
-      is_deeply($expect_tags, \%tags, "check tags for $filename");
+    my $check = Imager->new;
+    ok($check->read(file=> "testout/$filename"),
+       "read $filename");
+    
+    my %tags;
+    for my $key (keys %$expect_tags) {
+      $tags{$key} = $check->tags(name=>$key);
     }
+    is_deeply($expect_tags, \%tags, "check tags for $filename");
   }
+}
 
-  { # Issue # 17981
-    # the test image has a zero-length user_comment field
-    # the code would originally attempt to convert '\0' to ' '
-    # for the first 8 bytes, even if the string was less than 
-    # 8 bytes long
-    my $im = Imager->new;
-    ok($im->read(file => 'testimg/209_yonge.jpg', type=>'jpeg'),
-       "test read of image with invalid exif_user_comment");
-    is($im->tags(name=>'exif_user_comment'), '',
-       "check exif_user_comment set correctly");
-  }
-
-  { # test parseiptc handling no IPTC data correctly
-    my $saw_warn;
-    local $SIG{__WARN__} = 
-      sub {
-       ++$saw_warn;
-       print "# @_\n";
-      };
-    my $im = Imager->new;
-    ok($im->read(file => 'testout/t101.jpg', type=>'jpeg'),
-       "read jpeg with no IPTC data");
-    ok(!defined $im->{IPTCRAW}, "no iptc data");
-    my %iptc = $im->parseiptc;
-    ok(!$saw_warn, "should be no warnings");
-  }
-
-  { # Issue # 18397
-    # attempting to write a 4 channel image to a bufchain would
-    # cause a seg fault.
-    # it should fail still
-    # overridden by # 29876
-    # give 4/2 channel images a background color when saving to JPEG
-    my $im = Imager->new(xsize => 16, ysize => 16, channels => 4);
-    $im->box(filled => 1, xmin => 8, color => '#FFE0C0');
-    my $data;
-    ok($im->write(data => \$data, type => 'jpeg'),
-       "should write with a black background");
-    my $imread = Imager->new;
-    ok($imread->read(data => $data, type => 'jpeg'), 'read it back');
-    is_color_close3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0, 4,
-             "check it's black");
-    is_color_close3($imread->getpixel('x' => 15, 'y' => 9), 255, 224, 192, 4,
-                   "check filled area filled");
+{ # Issue # 17981
+  # the test image has a zero-length user_comment field
+  # the code would originally attempt to convert '\0' to ' '
+  # for the first 8 bytes, even if the string was less than 
+  # 8 bytes long
+  my $im = Imager->new;
+  ok($im->read(file => 'testimg/209_yonge.jpg', type=>'jpeg'),
+     "test read of image with invalid exif_user_comment");
+  is($im->tags(name=>'exif_user_comment'), '',
+     "check exif_user_comment set correctly");
+}
 
-    # write with a red background
-    $data = '';
-    ok($im->write(data => \$data, type => 'jpeg', i_background => '#FF0000'),
-       "write with red background");
-    ok($imread->read(data => $data, type => 'jpeg'), "read it back");
-    is_color_close3($imread->getpixel('x' => 0, 'y' => 0), 255, 0, 0, 4,
-             "check it's red");
-    is_color_close3($imread->getpixel('x' => 15, 'y' => 9), 255, 224, 192, 4,
-                   "check filled area filled");
-  }
- SKIP:
-  { # Issue # 18496
-    # If a jpeg with EXIF data containing an (invalid) IFD entry with a 
-    # type of zero is read then Imager crashes with a Floating point 
-    # exception
-    # testimg/zerojpeg.jpg was manually modified from exiftest.jpg to
-    # reproduce the problem.
-    Imager::i_exif_enabled()
-       or skip("no exif support", 1);
-    my $im = Imager->new;
-    ok($im->read(file=>'testimg/zerotype.jpg'), "shouldn't crash");
-  }
+{ # test parseiptc handling no IPTC data correctly
+  my $saw_warn;
+  local $SIG{__WARN__} = 
+    sub {
+      ++$saw_warn;
+      print "# @_\n";
+    };
+  my $im = Imager->new;
+  ok($im->read(file => 'testout/t101.jpg', type=>'jpeg'),
+     "read jpeg with no IPTC data");
+  ok(!defined $im->{IPTCRAW}, "no iptc data");
+  my %iptc = $im->parseiptc;
+  ok(!$saw_warn, "should be no warnings");
+}
 
- SKIP:
-  { # code coverage - make sure wiol_skip_input_data is called
-    open BASEDATA, "< testimg/exiftest.jpg"
-      or skip "can't open base data", 1;
-    binmode BASEDATA;
-    my $data = do { local $/; <BASEDATA> };
-    close BASEDATA;
-    
-    substr($data, 3, 1) eq "\xE1"
-      or skip "base data isn't as expected", 1;
-    # inserting a lot of marker data here means we take the branch in 
-    # wiol_skip_input_data that refills the buffer
-    my $marker = "\xFF\xE9"; # APP9 marker
-    $marker .= pack("n", 8192) . "x" x 8190;
-    $marker x= 10; # make it take up a lot of space
-    substr($data, 2, 0) = $marker;
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read with a skip of data");
-  }
+{ # Issue # 18397
+  # attempting to write a 4 channel image to a bufchain would
+  # cause a seg fault.
+  # it should fail still
+  # overridden by # 29876
+  # give 4/2 channel images a background color when saving to JPEG
+  my $im = Imager->new(xsize => 16, ysize => 16, channels => 4);
+  $im->box(filled => 1, xmin => 8, color => '#FFE0C0');
+  my $data;
+  ok($im->write(data => \$data, type => 'jpeg'),
+     "should write with a black background");
+  my $imread = Imager->new;
+  ok($imread->read(data => $data, type => 'jpeg'), 'read it back');
+  is_color_close3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0, 4,
+                 "check it's black");
+  is_color_close3($imread->getpixel('x' => 15, 'y' => 9), 255, 224, 192, 4,
+                 "check filled area filled");
   
- SKIP:
-  { # code coverage - take the branch that provides a fake EOI
-    open BASEDATA, "< testimg/exiftest.jpg"
-      or skip "can't open base data", 1;
-    binmode BASEDATA;
-    my $data = do { local $/; <BASEDATA> };
-    close BASEDATA;
-    substr($data, -1000) = '';
-
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read with image data truncated");
-  }
+  # write with a red background
+  $data = '';
+  ok($im->write(data => \$data, type => 'jpeg', i_background => '#FF0000'),
+     "write with red background");
+  ok($imread->read(data => $data, type => 'jpeg'), "read it back");
+  is_color_close3($imread->getpixel('x' => 0, 'y' => 0), 255, 0, 0, 4,
+                 "check it's red");
+  is_color_close3($imread->getpixel('x' => 15, 'y' => 9), 255, 224, 192, 4,
+                 "check filled area filled");
+}
+SKIP:
+{ # Issue # 18496
+  # If a jpeg with EXIF data containing an (invalid) IFD entry with a 
+  # type of zero is read then Imager crashes with a Floating point 
+  # exception
+  # testimg/zerojpeg.jpg was manually modified from exiftest.jpg to
+  # reproduce the problem.
+  Imager::i_exif_enabled()
+      or skip("no exif support", 1);
+  my $im = Imager->new;
+  ok($im->read(file=>'testimg/zerotype.jpg'), "shouldn't crash");
+}
 
-  { # code coverage - make sure wiol_empty_output_buffer is called
-    my $im = Imager->new(xsize => 1000, ysize => 1000);
-    for my $x (0 .. 999) {
-      $im->line(x1 => $x, y1 => 0, x2 => $x, y2 => 999,
-                color => Imager::Color->new(rand 256, rand 256, rand 256));
-    }
-    my $data;
-    ok($im->write(data => \$data, type=>'jpeg', jpegquality => 100), 
-       "write big file to ensure wiol_empty_output_buffer is called");
+SKIP:
+{ # code coverage - make sure wiol_skip_input_data is called
+  open BASEDATA, "< testimg/exiftest.jpg"
+    or skip "can't open base data", 1;
+  binmode BASEDATA;
+  my $data = do { local $/; <BASEDATA> };
+  close BASEDATA;
+  
+  substr($data, 3, 1) eq "\xE1"
+    or skip "base data isn't as expected", 1;
+  # inserting a lot of marker data here means we take the branch in 
+  # wiol_skip_input_data that refills the buffer
+  my $marker = "\xFF\xE9"; # APP9 marker
+  $marker .= pack("n", 8192) . "x" x 8190;
+  $marker x= 10; # make it take up a lot of space
+  substr($data, 2, 0) = $marker;
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read with a skip of data");
+}
 
-    # code coverage - write failure path in wiol_empty_output_buffer
-    ok(!$im->write(callback => sub { return },
-                   type => 'jpeg', jpegquality => 100),
-       "fail to write")
-      and print "# ", $im->errstr, "\n";
-  }
+SKIP:
+{ # code coverage - take the branch that provides a fake EOI
+  open BASEDATA, "< testimg/exiftest.jpg"
+    or skip "can't open base data", 1;
+  binmode BASEDATA;
+  my $data = do { local $/; <BASEDATA> };
+  close BASEDATA;
+  substr($data, -1000) = '';
+  
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read with image data truncated");
+}
 
-  { # code coverage - virtual image branch in i_writejpeg_wiol()
-    my $im = $imoo->copy;
-    my $immask = $im->masked;
-    ok($immask, "made a virtual image (via masked)");
-    ok($immask->virtual, "check it's virtual");
-    my $mask_data;
-    ok($immask->write(data => \$mask_data, type => 'jpeg'),
-       "write masked version");
-    my $base_data;
-    ok($im->write(data => \$base_data, type=>'jpeg'),
-       "write normal version");
-    is($base_data, $mask_data, "check the data written matches");
+{ # code coverage - make sure wiol_empty_output_buffer is called
+  my $im = Imager->new(xsize => 1000, ysize => 1000);
+  for my $x (0 .. 999) {
+    $im->line(x1 => $x, y1 => 0, x2 => $x, y2 => 999,
+             color => Imager::Color->new(rand 256, rand 256, rand 256));
   }
+  my $data;
+  ok($im->write(data => \$data, type=>'jpeg', jpegquality => 100), 
+     "write big file to ensure wiol_empty_output_buffer is called");
+  
+  # code coverage - write failure path in wiol_empty_output_buffer
+  ok(!$im->write(callback => sub { return },
+                type => 'jpeg', jpegquality => 100),
+     "fail to write")
+    and print "# ", $im->errstr, "\n";
+}
 
- SKIP:
-  { # code coverage - IPTC data
-    # this is dummy data
-    my $iptc = "\x04\x04" .
-      "\034\002x   My Caption"
-        . "\034\002P   Tony Cook"
-          . "\034\002i   Dummy Headline!"
-            . "\034\002n   No Credit Given";
-    
-    my $app13 = "\xFF\xED" . pack("n", 2 + length $iptc) . $iptc;
-
-    open BASEDATA, "< testimg/exiftest.jpg"
-      or skip "can't open base data", 1;
-    binmode BASEDATA;
-    my $data = do { local $/; <BASEDATA> };
-    close BASEDATA;
-    substr($data, 2, 0) = $app13;
+{ # code coverage - virtual image branch in i_writejpeg_wiol()
+  my $im = $imoo->copy;
+  my $immask = $im->masked;
+  ok($immask, "made a virtual image (via masked)");
+  ok($immask->virtual, "check it's virtual");
+  my $mask_data;
+  ok($immask->write(data => \$mask_data, type => 'jpeg'),
+     "write masked version");
+  my $base_data;
+  ok($im->write(data => \$base_data, type=>'jpeg'),
+     "write normal version");
+  is($base_data, $mask_data, "check the data written matches");
+}
 
-    my $im = Imager->new;
-    ok($im->read(data => $data), "read with app13 data");
-    my %iptc = $im->parseiptc;
-    is($iptc{caption}, 'My Caption', 'check iptc caption');
-    is($iptc{photogr}, 'Tony Cook', 'check iptc photogr');
-    is($iptc{headln}, 'Dummy Headline!', 'check iptc headln');
-    is($iptc{credit}, 'No Credit Given', 'check iptc credit');
-  }
+SKIP:
+{ # code coverage - IPTC data
+  # this is dummy data
+  my $iptc = "\x04\x04" .
+    "\034\002x   My Caption"
+      . "\034\002P   Tony Cook"
+       . "\034\002i   Dummy Headline!"
+         . "\034\002n   No Credit Given";
+  
+  my $app13 = "\xFF\xED" . pack("n", 2 + length $iptc) . $iptc;
+  
+  open BASEDATA, "< testimg/exiftest.jpg"
+    or skip "can't open base data", 1;
+  binmode BASEDATA;
+  my $data = do { local $/; <BASEDATA> };
+  close BASEDATA;
+  substr($data, 2, 0) = $app13;
+  
+  my $im = Imager->new;
+  ok($im->read(data => $data), "read with app13 data");
+  my %iptc = $im->parseiptc;
+  is($iptc{caption}, 'My Caption', 'check iptc caption');
+  is($iptc{photogr}, 'Tony Cook', 'check iptc photogr');
+  is($iptc{headln}, 'Dummy Headline!', 'check iptc headln');
+  is($iptc{credit}, 'No Credit Given', 'check iptc credit');
+}
 
-  { # handling of CMYK jpeg
-    # http://rt.cpan.org/Ticket/Display.html?id=20416
-    my $im = Imager->new;
-    ok($im->read(file => 'testimg/scmyk.jpg'), 'read a CMYK jpeg');
-    is($im->getchannels, 3, "check channel count");
-    my $col = $im->getpixel(x => 0, 'y' => 0);
-    ok($col, "got the 'black' pixel");
-    # this is jpeg, so we can't compare colors exactly
-    # older versions returned this pixel at a light color, but
-    # it's black in the image
-    my ($r, $g, $b) = $col->rgba;
-    cmp_ok($r, '<', 10, 'black - red low');
-    cmp_ok($g, '<', 10, 'black - green low');
-    cmp_ok($b, '<', 10, 'black - blue low');
-    $col = $im->getpixel(x => 15, 'y' => 0);
-    ok($col, "got the dark blue");
-    ($r, $g, $b) = $col->rgba;
-    cmp_ok($r, '<', 10, 'dark blue - red low');
-    cmp_ok($g, '<', 10, 'dark blue - green low');
-    cmp_ok($b, '>', 110, 'dark blue - blue middle (bottom)');
-    cmp_ok($b, '<', 130, 'dark blue - blue middle (top)');
-    $col = $im->getpixel(x => 0, 'y' => 15);
-    ok($col, "got the red");
-    ($r, $g, $b) = $col->rgba;
-    cmp_ok($r, '>', 245, 'red - red high');
-    cmp_ok($g, '<', 10, 'red - green low');
-    cmp_ok($b, '<', 10, 'red - blue low');
-  }
+{ # handling of CMYK jpeg
+  # http://rt.cpan.org/Ticket/Display.html?id=20416
+  my $im = Imager->new;
+  ok($im->read(file => 'testimg/scmyk.jpg'), 'read a CMYK jpeg');
+  is($im->getchannels, 3, "check channel count");
+  my $col = $im->getpixel(x => 0, 'y' => 0);
+  ok($col, "got the 'black' pixel");
+  # this is jpeg, so we can't compare colors exactly
+  # older versions returned this pixel at a light color, but
+  # it's black in the image
+  my ($r, $g, $b) = $col->rgba;
+  cmp_ok($r, '<', 10, 'black - red low');
+  cmp_ok($g, '<', 10, 'black - green low');
+  cmp_ok($b, '<', 10, 'black - blue low');
+  $col = $im->getpixel(x => 15, 'y' => 0);
+  ok($col, "got the dark blue");
+  ($r, $g, $b) = $col->rgba;
+  cmp_ok($r, '<', 10, 'dark blue - red low');
+  cmp_ok($g, '<', 10, 'dark blue - green low');
+  cmp_ok($b, '>', 110, 'dark blue - blue middle (bottom)');
+  cmp_ok($b, '<', 130, 'dark blue - blue middle (top)');
+  $col = $im->getpixel(x => 0, 'y' => 15);
+  ok($col, "got the red");
+  ($r, $g, $b) = $col->rgba;
+  cmp_ok($r, '>', 245, 'red - red high');
+  cmp_ok($g, '<', 10, 'red - green low');
+  cmp_ok($b, '<', 10, 'red - blue low');
+}
 
-  {
-    ok(grep($_ eq 'jpeg', Imager->read_types), "check jpeg in read types");
-    ok(grep($_ eq 'jpeg', Imager->write_types), "check jpeg in write types");
-  }
+{
+  ok(grep($_ eq 'jpeg', Imager->read_types), "check jpeg in read types");
+  ok(grep($_ eq 'jpeg', Imager->write_types), "check jpeg in write types");
 }
 
+
diff --git a/t/t101nojpeg.t b/t/t101nojpeg.t
new file mode 100644 (file)
index 0000000..4eced40
--- /dev/null
@@ -0,0 +1,20 @@
+#!perl -w
+use strict;
+use Test::More;
+use Imager qw(:all);
+
+init_log("testout/t101jpeg.log",1);
+
+i_has_format("jpeg")
+  and plan skip_all => "have jpeg support - this tests the lack of it";
+
+plan tests => 6;
+
+my $im = Imager->new;
+ok(!$im->read(file=>"testimg/base.jpg"), "should fail to read jpeg");
+cmp_ok($im->errstr, '=~', qr/format 'jpeg' not supported/, "check no jpeg message");
+$im = Imager->new(xsize=>2, ysize=>2);
+ok(!$im->write(file=>"testout/nojpeg.jpg"), "should fail to write jpeg");
+cmp_ok($im->errstr, '=~', qr/format 'jpeg' not supported/, "check no jpeg message");
+ok(!grep($_ eq 'jpeg', Imager->read_types), "check jpeg not in read types");
+ok(!grep($_ eq 'jpeg', Imager->write_types), "check jpeg not in write types");