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";
$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);
# 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";
}
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 },
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");
+}