]> git.imager.perl.org - imager.git/blobdiff - JPEG/t/t10jpeg.t
add braces to some multi-line if() and for()
[imager.git] / JPEG / t / t10jpeg.t
index 1512666fc5f6ae1551c7c74a3aebda3b01b86bb3..3408f068be064c009e8872594559221ff82f2818 100644 (file)
@@ -2,7 +2,7 @@
 use strict;
 use Imager qw(:all);
 use Test::More;
-use Imager::Test qw(is_color_close3 test_image_raw);
+use Imager::Test qw(is_color_close3 test_image_raw test_image is_image);
 
 -d "testout" or mkdir "testout";
 
@@ -11,7 +11,9 @@ init_log("testout/t101jpeg.log",1);
 $Imager::formats{"jpeg"}
   or plan skip_all => "no jpeg support";
 
-plan tests => 94;
+plan tests => 109;
+
+print STDERR "libjpeg version: ", Imager::File::JPEG::i_libjpeg_version(), "\n";
 
 my $green=i_color_new(0,255,0,255);
 my $blue=i_color_new(0,0,255,255);
@@ -55,7 +57,9 @@ 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');
+my $io = Imager::io_new_fd(fileno(FH));
+$io->set_buffered(0);
+ok(!$imoo->write(io => $io, type=>'jpeg'), 'failure handling');
 close FH;
 print "# ",$imoo->errstr,"\n";
 
@@ -324,7 +328,8 @@ SKIP:
   }
   my $data;
   ok($im->write(data => \$data, type=>'jpeg', jpegquality => 100), 
-     "write big file to ensure wiol_empty_output_buffer is called");
+     "write big file to ensure wiol_empty_output_buffer is called")
+    or print "# ", $im->errstr, "\n";
   
   # code coverage - write failure path in wiol_empty_output_buffer
   ok(!$im->write(callback => sub { return },
@@ -408,4 +413,59 @@ SKIP:
   ok(grep($_ eq 'jpeg', Imager->write_types), "check jpeg in write types");
 }
 
+{ # progressive JPEG
+  # https://rt.cpan.org/Ticket/Display.html?id=68691
+  my $im = test_image();
+  my $progim = $im->copy;
+
+  ok($progim->write(file => "testout/t10prog.jpg", type => "jpeg",
+                   jpeg_progressive => 1),
+     "write progressive jpeg");
+
+  my $rdprog = Imager->new(file => "testout/t10prog.jpg");
+  ok($rdprog, "read progressive jpeg");
+  my @prog = $rdprog->tags(name => "jpeg_progressive");
+  is($prog[0], 1, "check progressive flag set on read");
 
+  my $data;
+  ok($im->write(data => \$data, type => "jpeg"), 
+     "save as non-progressive to compare");
+  my $norm = Imager->new(data => $data);
+  ok($norm, "read non-progressive file");
+  my @nonprog = $norm->tags(name => "jpeg_progressive");
+  is($nonprog[0], 0, "check progressive flag 0 for non prog file");
+
+  is_image($rdprog, $norm, "prog vs norm should be the same image");
+}
+
+SKIP:
+{ # optimize coding
+  my $im = test_image();
+  my $base;
+  ok($im->write(data => \$base, type => "jpeg"), "save without optimize");
+  my $opt;
+  ok($im->write(data => \$opt, type => "jpeg", jpeg_optimize => 1),
+     "save with optimize");
+  cmp_ok(length $opt, '<', length $base, "check optimized is smaller");
+  my $im_base = Imager->new(data => $base, filetype => "jpeg");
+  ok($im_base, "read unoptimized back");
+  my $im_opt = Imager->new(data => $opt, filetype => "jpeg");
+  ok($im_opt, "read optimized back");
+  $im_base && $im_opt
+    or skip "couldn't read one back", 1;
+  is_image($im_opt, $im_base,
+          "optimization should only change huffman compression, not quality");
+}
+
+{ # check close failures are handled correctly
+  my $im = test_image();
+  my $fail_close = sub {
+    Imager::i_push_error(0, "synthetic close failure");
+    return 0;
+  };
+  ok(!$im->write(type => "jpeg", callback => sub { 1 },
+                closecb => $fail_close),
+     "check failing close fails");
+    like($im->errstr, qr/synthetic close failure/,
+        "check error message");
+}