X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/867acf5b8663b5b5944dbceacef4d346fe70eae1..43cc769f105320f5dc0aaefe3d56ef2108f60000:/t/t104ppm.t diff --git a/t/t104ppm.t b/t/t104ppm.t index 546aa1cb..c85d7a9b 100644 --- a/t/t104ppm.t +++ b/t/t104ppm.t @@ -1,22 +1,25 @@ #!perl -w use Imager ':all'; -use Test::More tests => 64; +use Test::More tests => 205; use strict; +use Imager::Test qw(test_image_raw test_image_16 is_color3 is_color1 is_image test_image_named); -init_log("testout/t104ppm.log",1); +$| = 1; + +-d "testout" or mkdir "testout"; + +Imager->open_log(log => "testout/t104ppm.log"); 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 @files; -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 $img = test_image_raw(); my $fh = openimage(">testout/t104.ppm"); +push @files, "t104.ppm"; my $IO = Imager::io_new_fd(fileno($fh)); ok(i_writeppm_wiol($img, $IO), "write pnm low") or die "Cannot write testout/t104.ppm\n"; @@ -48,6 +51,7 @@ i_box_filled($gimg, 20, 20, 130, 130, $gray); i_box_filled($gimg, 40, 40, 110, 110, $dgray); i_arc($gimg, 75, 75, 30, 0, 361, $white); +push @files, "t104_gray.pgm"; open FH, "> testout/t104_gray.pgm" or die "Cannot create testout/t104_gray.pgm: $!\n"; binmode FH; $IO = Imager::io_new_fd(fileno(FH)); @@ -63,12 +67,15 @@ is(i_img_diff($gimg, $gcmpimg), 0, "compare written and read greyscale images"); my $ooim = Imager->new; -ok($ooim->read(file=>"testimg/simple.pbm"), "read simple pbm, via OO"); +ok($ooim->read(file=>"testimg/simple.pbm"), "read simple pbm, via OO") + or print "# ", $ooim->errstr, "\n"; -check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 0), 255); -check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 1), 0); -check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 0), 0); -check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); +check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 0), 0); +check_gray(Imager::i_get_pixel($ooim->{IMG}, 0, 1), 255); +check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 0), 255); +check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 0); +is($ooim->type, 'paletted', "check pbm read as paletted"); +is($ooim->tags(name=>'pnm_type'), 1, "check pnm_type tag"); { # https://rt.cpan.org/Ticket/Display.html?id=7465 @@ -87,9 +94,10 @@ check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); # check the pixels ok(my ($white, $grey, $green) = $maxval->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels"); - check_color($white, 255, 255, 255, "white pixel"); - check_color($grey, 130, 130, 130, "grey pixel"); - check_color($green, 125, 125, 0, "green pixel"); + is_color3($white, 255, 255, 255, "white pixel"); + is_color3($grey, 130, 130, 130, "grey pixel"); + is_color3($green, 125, 125, 0, "green pixel"); + is($maxval->tags(name=>'pnm_type'), 6, "check pnm_type tag on maxval"); # and do the same for ASCII images my $maxval_asc = Imager->new; @@ -103,12 +111,14 @@ check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); is($maxval_asc->getchannels, 3, "channel count"); is($maxval_asc->getwidth, 3, "width"); is($maxval_asc->getheight, 1, "height"); + + is($maxval->tags(name=>'pnm_type'), 6, "check pnm_type tag on maxval"); # check the pixels ok(my ($white_asc, $grey_asc, $green_asc) = $maxval_asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels"); - check_color($white_asc, 255, 255, 255, "white asc pixel"); - check_color($grey_asc, 130, 130, 130, "grey asc pixel"); - check_color($green_asc, 125, 125, 0, "green asc pixel"); + is_color3($white_asc, 255, 255, 255, "white asc pixel"); + is_color3($grey_asc, 130, 130, 130, "grey asc pixel"); + is_color3($green_asc, 125, 125, 0, "green asc pixel"); } { # previously we didn't validate maxval at all, make sure it's @@ -127,13 +137,15 @@ check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); like($maxval65536->errstr, qr/maxval of 65536 is over 65535 - invalid pnm file/, "error expected from reading maxval_65536.ppm"); - # maxval of 256 is valid, but Imager can't handle it yet in binary files + # maxval of 256 is valid, and handled as of 0.56 my $maxval256 = Imager->new; - ok(!$maxval256->read(file=>'testimg/maxval_256.ppm'), - "should fail reading maxval 256 image"); - print "# ",$maxval256->errstr,"\n"; - like($maxval256->errstr, qr/maxval of 256 is over 255 - not currently supported by Imager/, - "error expected from reading maxval_256.ppm"); + ok($maxval256->read(file=>'testimg/maxval_256.ppm'), + "should succeed reading maxval 256 image"); + is_color3($maxval256->getpixel(x => 0, 'y' => 0), + 0, 0, 0, "check black in maxval_256"); + is_color3($maxval256->getpixel(x => 0, 'y' => 1), + 255, 255, 255, "check white in maxval_256"); + is($maxval256->bits, 16, "check bits/sample on maxval 256"); # make sure we handle maxval > 255 for ascii my $maxval4095asc = Imager->new; @@ -142,11 +154,12 @@ check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); is($maxval4095asc->getchannels, 3, "channels"); is($maxval4095asc->getwidth, 3, "width"); is($maxval4095asc->getheight, 1, "height"); + is($maxval4095asc->bits, 16, "check bits/sample on maxval 4095"); ok(my ($white, $grey, $green) = $maxval4095asc->getpixel('x'=>[0,1,2], 'y'=>[0,0,0]), "fetch pixels"); - check_color($white, 255, 255, 255, "white 4095 pixel"); - check_color($grey, 128, 128, 128, "grey 4095 pixel"); - check_color($green, 127, 127, 0, "green 4095 pixel"); + is_color3($white, 255, 255, 255, "white 4095 pixel"); + is_color3($grey, 128, 128, 128, "grey 4095 pixel"); + is_color3($green, 127, 127, 0, "green 4095 pixel"); } { # check i_format is set when reading a pnm file @@ -194,18 +207,435 @@ check_gray(Imager::i_get_pixel($ooim->{IMG}, 1, 1), 255); Imager->set_file_limits(reset=>1); } +{ + # check we correctly sync with the data stream + my $im = Imager->new; + ok($im->read(file => 'testimg/pgm.pgm', type => 'pnm'), + "read pgm.pgm") + or print "# cannot read pgm.pgm: ", $im->errstr, "\n"; + print "# ", $im->getsamples('y' => 0), "\n"; + is_color1($im->getpixel(x=>0, 'y' => 0), 254, "check top left"); +} + { # check error messages set correctly - my $im = Imager->new(xsize=>100, ysize=>100, channels=>4); - ok(!$im->write(file=>"testout/t104_fail.ppm", type=>'pnm'), - "should fail to write 4 channel image"); - is($im->errstr, 'can only save 1 or 3 channel images to pnm', - "check error message"); + my $im = Imager->new; ok(!$im->read(file=>'t/t104ppm.t', type=>'pnm'), 'should fail to read script as an image file'); is($im->errstr, 'unable to read pnm image: bad header magic, not a PNM file', "check error message"); } +{ + # RT #30074 + # give 4/2 channel images a background color when saving to pnm + my $im = Imager->new(xsize=>16, ysize=>16, channels=>4); + $im->box(filled => 1, xmin => 8, color => '#FFE0C0'); + $im->box(filled => 1, color => NC(0, 192, 192, 128), + ymin => 8, xmax => 7); + push @files, "t104_alpha.ppm"; + ok($im->write(file=>"testout/t104_alpha.ppm", type=>'pnm'), + "should succeed writing 4 channel image"); + my $imread = Imager->new; + ok($imread->read(file => 'testout/t104_alpha.ppm'), "read it back") + or print "# ", $imread->errstr, "\n"; + is_color3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0, + "check transparent became black"); + is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192, + "check color came through"); + is_color3($imread->getpixel('x' => 0, 'y' => 15), 0, 96, 96, + "check translucent came through"); + my $data; + ok($im->write(data => \$data, type => 'pnm', i_background => '#FF0000'), + "write with red background"); + ok($imread->read(data => $data, type => 'pnm'), + "read it back"); + is_color3($imread->getpixel('x' => 0, 'y' => 0), 255, 0, 0, + "check transparent became red"); + is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192, + "check color came through"); + is_color3($imread->getpixel('x' => 0, 'y' => 15), 127, 96, 96, + "check translucent came through"); +} + +{ + # more RT #30074 - 16 bit images + my $im = Imager->new(xsize=>16, ysize=>16, channels=>4, bits => 16); + $im->box(filled => 1, xmin => 8, color => '#FFE0C0'); + $im->box(filled => 1, color => NC(0, 192, 192, 128), + ymin => 8, xmax => 7); + push @files, "t104_alp16.ppm"; + ok($im->write(file=>"testout/t104_alp16.ppm", type=>'pnm', + pnm_write_wide_data => 1), + "should succeed writing 4 channel image"); + my $imread = Imager->new; + ok($imread->read(file => 'testout/t104_alp16.ppm'), "read it back"); + is($imread->bits, 16, "check we did produce a 16 bit image"); + is_color3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0, + "check transparent became black"); + is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192, + "check color came through"); + is_color3($imread->getpixel('x' => 0, 'y' => 15), 0, 96, 96, + "check translucent came through"); + my $data; + ok($im->write(data => \$data, type => 'pnm', i_background => '#FF0000', + pnm_write_wide_data => 1), + "write with red background"); + ok($imread->read(data => $data, type => 'pnm'), + "read it back"); + is($imread->bits, 16, "check it's 16-bit"); + is_color3($imread->getpixel('x' => 0, 'y' => 0), 255, 0, 0, + "check transparent became red"); + is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192, + "check color came through"); + is_color3($imread->getpixel('x' => 0, 'y' => 15), 127, 96, 96, + "check translucent came through"); +} + +# various bad input files +print "# check error handling\n"; +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_bin.ppm', type=>'pnm'), + "fail to read short bin ppm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_bin16.ppm', type=>'pnm'), + "fail to read short bin ppm (maxval 65535)"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_bin.pgm', type=>'pnm'), + "fail to read short bin pgm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_bin16.pgm', type=>'pnm'), + "fail to read short bin pgm (maxval 65535)"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_bin.pbm', type => 'pnm'), + "fail to read a short bin pbm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_asc.ppm', type => 'pnm'), + "fail to read a short asc ppm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_asc.pgm', type => 'pnm'), + "fail to read a short asc pgm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/short_asc.pbm', type => 'pnm'), + "fail to read a short asc pbm"); + cmp_ok($im->errstr, '=~', 'short read - file truncated', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/bad_asc.ppm', type => 'pnm'), + "fail to read a bad asc ppm"); + cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/bad_asc.pgm', type => 'pnm'), + "fail to read a bad asc pgm"); + cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm', + "check error message"); +} + +{ + my $im = Imager->new; + ok(!$im->read(file => 'testimg/bad_asc.pbm', type => 'pnm'), + "fail to read a bad asc pbm"); + cmp_ok($im->errstr, '=~', 'invalid data for ascii pnm', + "check error message"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_bin.ppm', type => 'pnm', + allow_incomplete => 1), + "partial read bin ppm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_bin16.ppm', type => 'pnm', + allow_incomplete => 1), + "partial read bin16 ppm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); + is($im->bits, 16, "check correct bits"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_bin.pgm', type => 'pnm', + allow_incomplete => 1), + "partial read bin pgm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_bin16.pgm', type => 'pnm', + allow_incomplete => 1), + "partial read bin16 pgm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_bin.pbm', type => 'pnm', + allow_incomplete => 1), + "partial read bin pbm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_asc.ppm', type => 'pnm', + allow_incomplete => 1), + "partial read asc ppm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_asc.pgm', type => 'pnm', + allow_incomplete => 1), + "partial read asc pgm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/short_asc.pbm', type => 'pnm', + allow_incomplete => 1), + "partial read asc pbm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my @imgs = Imager->read_multi(file => 'testimg/multiple.ppm'); + is( 0+@imgs, 3, "Read 3 images"); + is( $imgs[0]->tags( name => 'pnm_type' ), 1, "Image 1 is type 1" ); + is( $imgs[0]->getwidth, 2, " ... width=2" ); + is( $imgs[0]->getheight, 2, " ... width=2" ); + is( $imgs[1]->tags( name => 'pnm_type' ), 6, "Image 2 is type 6" ); + is( $imgs[1]->getwidth, 164, " ... width=164" ); + is( $imgs[1]->getheight, 180, " ... width=180" ); + is( $imgs[2]->tags( name => 'pnm_type' ), 5, "Image 3 is type 5" ); + is( $imgs[2]->getwidth, 2, " ... width=2" ); + is( $imgs[2]->getheight, 2, " ... width=2" ); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/bad_asc.ppm', type => 'pnm', + allow_incomplete => 1), + "partial read bad asc ppm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/bad_asc.pgm', type => 'pnm', + allow_incomplete => 1), + "partial read bad asc pgm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + my $im = Imager->new; + ok($im->read(file => 'testimg/bad_asc.pbm', type => 'pnm', + allow_incomplete => 1), + "partial read bad asc pbm"); + is($im->tags(name => 'i_incomplete'), 1, "partial flag set"); + is($im->tags(name => 'i_lines_read'), 1, "lines_read set"); +} + +{ + print "# monochrome output\n"; + my $im = Imager->new(xsize => 10, ysize => 10, channels => 1, type => 'paletted'); + ok($im->addcolors(colors => [ '#000000', '#FFFFFF' ]), + "add black and white"); + $im->box(filled => 1, xmax => 4, color => '#000000'); + $im->box(filled => 1, xmin => 5, color => '#FFFFFF'); + is($im->type, 'paletted', 'mono still paletted'); + push @files, "t104_mono.pbm"; + ok($im->write(file => 'testout/t104_mono.pbm', type => 'pnm'), + "save as pbm"); + + # check it + my $imread = Imager->new; + ok($imread->read(file => 'testout/t104_mono.pbm', type=>'pnm'), + "read it back in") + or print "# ", $imread->errstr, "\n"; + is($imread->type, 'paletted', "check result is paletted"); + is($imread->tags(name => 'pnm_type'), 4, "check type"); + is_image($im, $imread, "check image matches"); +} + +{ + print "# monochrome output - reversed palette\n"; + my $im = Imager->new(xsize => 10, ysize => 10, channels => 1, type => 'paletted'); + ok($im->addcolors(colors => [ '#FFFFFF', '#000000' ]), + "add white and black"); + $im->box(filled => 1, xmax => 4, color => '#000000'); + $im->box(filled => 1, xmin => 5, color => '#FFFFFF'); + is($im->type, 'paletted', 'mono still paletted'); + push @files, "t104_mono2.pbm"; + ok($im->write(file => 'testout/t104_mono2.pbm', type => 'pnm'), + "save as pbm"); + + # check it + my $imread = Imager->new; + ok($imread->read(file => 'testout/t104_mono2.pbm', type=>'pnm'), + "read it back in") + or print "# ", $imread->errstr, "\n"; + is($imread->type, 'paletted', "check result is paletted"); + is($imread->tags(name => 'pnm_type'), 4, "check type"); + is_image($im, $imread, "check image matches"); +} + +{ + print "# 16-bit output\n"; + my $data; + my $im = test_image_16(); + + # without tag, it should do 8-bit output + ok($im->write(data => \$data, type => 'pnm'), + "write 16-bit image as 8-bit/sample ppm"); + my $im8 = Imager->new; + ok($im8->read(data => $data), "read it back"); + is($im8->tags(name => 'pnm_maxval'), 255, "check maxval"); + is_image($im, $im8, "check image matches"); + + # try 16-bit output + $im->settag(name => 'pnm_write_wide_data', value => 1); + $data = ''; + ok($im->write(data => \$data, type => 'pnm'), + "write 16-bit image as 16-bit/sample ppm"); + push @files, "t104_16.ppm"; + $im->write(file=>'testout/t104_16.ppm'); + my $im16 = Imager->new; + ok($im16->read(data => $data), "read it back"); + is($im16->tags(name => 'pnm_maxval'), 65535, "check maxval"); + push @files, "t104_16b.ppm"; + $im16->write(file=>'testout/t104_16b.ppm'); + is_image($im, $im16, "check image matches"); +} + +{ + ok(grep($_ eq 'pnm', Imager->read_types), "check pnm in read types"); + ok(grep($_ eq 'pnm', Imager->write_types), "check pnm in write types"); +} + +{ # test new() loading an image + my $im = Imager->new(file => "testimg/penguin-base.ppm"); + ok($im, "received an image"); + is($im->getwidth, 164, "check width matches image"); + + # fail to load an image + my $im2 = Imager->new(file => "Imager.pm", filetype => "pnm"); + ok(!$im2, "no image when file failed to load"); + cmp_ok(Imager->errstr, '=~', "bad header magic, not a PNM file", + "check error message transferred"); + + # load from data + SKIP: + { + ok(open(FH, "< testimg/penguin-base.ppm"), "open test file") + or skip("couldn't open data source", 4); + binmode FH; + my $imdata = do { local $/; }; + close FH; + ok(length $imdata, "we got the data"); + my $im3 = Imager->new(data => $imdata); + ok($im3, "read the file data"); + is($im3->getwidth, 164, "check width matches image"); + } +} + +{ # image too large handling + { + ok(!Imager->new(file => "testimg/toowide.ppm", filetype => "pnm"), + "fail to read a too wide image"); + is(Imager->errstr, "unable to read pnm image: could not read image width: integer overflow", + "check error message"); + } + { + ok(!Imager->new(file => "testimg/tootall.ppm", filetype => "pnm"), + "fail to read a too wide image"); + is(Imager->errstr, "unable to read pnm image: could not read image height: integer overflow", + "check error message"); + } +} + +{ # make sure close is checked for each image type + my $fail_close = sub { + Imager::i_push_error(0, "synthetic close failure"); + return 0; + }; + + for my $type (qw(basic basic16 gray gray16 mono)) { + my $im = test_image_named($type); + my $io = Imager::io_new_cb(sub { 1 }, undef, undef, $fail_close); + ok(!$im->write(io => $io, type => "pnm"), + "write $type image with a failing close handler"); + like($im->errstr, qr/synthetic close failure/, + "check error message"); + } +} + +Imager->close_log; + +unless ($ENV{IMAGER_KEEP_FILES}) { + unlink "testout/t104ppm.log"; + unlink map "testout/$_", @files; +} + sub openimage { my $fname = shift; local(*FH); @@ -229,10 +659,3 @@ sub check_gray { is($g, $gray, "compare gray"); } -sub check_color { - my ($c, $red, $green, $blue, $note) = @_; - - my ($r, $g, $b) = $c->rgba; - is_deeply([ $r, $g, $b], [ $red, $green, $blue ], - "$note ($r, $g, $b) compared to ($red, $green, $blue)"); -}