#!perl -w
use strict;
-use lib 't';
use Imager qw(:all);
-use Test::More tests => 54;
+use Test::More tests => 88;
init_log("testout/t101jpeg.log",1);
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 not supported/, "check no jpeg message");
- skip("no jpeg support", 50);
+ 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", 82);
}
} else {
open(FH,">testout/t101.jpg") || die "cannot open testout/t101.jpg for writing\n";
($cmpimg,undef) = i_readjpeg_wiol($IO);
close(FH);
- print "$cmpimg\n";
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");
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
+ my $im = Imager->new(xsize => 10, ysize => 10, channels => 4);
+ my $data;
+ ok(!$im->write(data => \$data, type => 'jpeg'),
+ "should fail to write but shouldn't crash");
+ is($im->errstr, "only 1 or 3 channels images can be saved as JPEG",
+ "check the error message");
+ }
+ 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");
+ }
+
+ 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");
+ }
+
+ 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 - 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";
+ }
+
+ { # 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");
+ }
+
+ 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');
+ }
+
+ {
+ ok(grep($_ eq 'jpeg', Imager->read_types), "check jpeg in read types");
+ ok(grep($_ eq 'jpeg', Imager->write_types), "check jpeg in write types");
+ }
}
projects / imager.git / blobdiff