From ce523fda37b524468f22c9dc147146e9ae48951e Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Sat, 5 Sep 2009 00:24:20 +0000 Subject: [PATCH] re-work gif tests to move no gif available tests to a separate file --- MANIFEST | 3 +- t/t105gif.t | 1298 ++++++++++++++++++++++++------------------------- t/t105nogif.t | 19 + 3 files changed, 660 insertions(+), 660 deletions(-) create mode 100644 t/t105nogif.t diff --git a/MANIFEST b/MANIFEST index 10202266..6eb56da0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -240,7 +240,8 @@ t/t102nopng.t Test handling when png not available t/t102png.t Test png support t/t103raw.t t/t104ppm.t -t/t105gif.t +t/t105gif.t Test gif support +t/t105nogif.t Test handling when gif not available t/t106tiff.t t/t107bmp.t t/t108tga.t diff --git a/t/t105gif.t b/t/t105gif.t index 64ede63d..2c0ef2ca 100644 --- a/t/t105gif.t +++ b/t/t105gif.t @@ -12,9 +12,9 @@ UPGRADE. use strict; $|=1; -use Test::More tests => 145; +use Test::More; use Imager qw(:all); -use Imager::Test qw(is_color3 test_image); +use Imager::Test qw(is_color3 test_image test_image_raw); use Carp 'confess'; $SIG{__DIE__} = sub { confess @_ }; @@ -23,171 +23,152 @@ my $buggy_giflib_file = "buggy_giflib.txt"; init_log("testout/t105gif.log",1); +i_has_format("gif") + or plan skip_all => "no gif support"; + +plan tests => 145; + 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; -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 $gifver = Imager::i_giflib_version(); +diag("giflib version (from header) $gifver"); -my $timg = Imager::ImgRaw::new(20, 20, 4); -my $trans = i_color_new(255, 0, 0, 127); -i_box_filled($timg, 0, 0, 20, 20, $green); -i_box_filled($timg, 2, 2, 18, 18, $trans); +open(FH,">testout/t105.gif") || die "Cannot open testout/t105.gif\n"; +binmode(FH); +ok(i_writegifmc($img,fileno(FH),6), "write low") or + die "Cannot write testout/t105.gif\n"; +close(FH); + +open(FH,"testout/t105.gif") || die "Cannot open testout/t105.gif\n"; +binmode(FH); +ok($img=i_readgif(fileno(FH)), "read low") + or die "Cannot read testout/t105.gif\n"; +close(FH); + +open(FH,"testout/t105.gif") || die "Cannot open testout/t105.gif\n"; +binmode(FH); +($img, my $palette)=i_readgif(fileno(FH)); +ok($img, "read palette") or die "Cannot read testout/t105.gif\n"; +close(FH); + +$palette=''; # just to skip a warning. + +# check that reading interlaced/non-interlaced versions of +# the same GIF produce the same image +# I could replace this with code that used Imager's built-in +# image comparison code, but I know this code revealed the error +open(FH, "testout/t105i.ppm" or die "Cannot create testout/t105i.ppm"; +binmode FH; +my $IO = Imager::io_new_fd( fileno(FH) ); +i_writeppm_wiol($imgi, $IO) + or die "Cannot write testout/t105i.ppm"; +close FH; + +open FH, ">testout/t105ni.ppm" or die "Cannot create testout/t105ni.ppm"; +binmode FH; +$IO = Imager::io_new_fd( fileno(FH) ); +i_writeppm_wiol($imgni, $IO) + or die "Cannot write testout/t105ni.ppm"; +close FH; + +# compare them +open FH, " }; +close FH; +open FH, " }; +close FH; +is($datai, $datani, "images match"); SKIP: { - unless (i_has_format("gif")) { - my $im = Imager->new; - ok(!$im->read(file=>"testimg/scale.gif"), "should fail to read gif"); - cmp_ok($im->errstr, '=~', "format 'gif' not supported", "check no gif message"); - $im = Imager->new(xsize=>2, ysize=>2); - ok(!$im->write(file=>"testout/nogif.gif"), "should fail to write gif"); - cmp_ok($im->errstr, '=~', "format 'gif' not supported", "check no gif message"); - ok(!grep($_ eq 'gif', Imager->read_types), "check gif not in read types"); - ok(!grep($_ eq 'gif', Imager->write_types), "check gif not in write types"); - skip("no gif support", 139); - } - my $gifver = Imager::i_giflib_version(); - diag("giflib version (from header) $gifver"); - - open(FH,">testout/t105.gif") || die "Cannot open testout/t105.gif\n"; - binmode(FH); - ok(i_writegifmc($img,fileno(FH),6), "write low") or - die "Cannot write testout/t105.gif\n"; - close(FH); - - open(FH,"testout/t105.gif") || die "Cannot open testout/t105.gif\n"; - binmode(FH); - ok($img=i_readgif(fileno(FH)), "read low") - or die "Cannot read testout/t105.gif\n"; - close(FH); - - open(FH,"testout/t105.gif") || die "Cannot open testout/t105.gif\n"; - binmode(FH); - ($img, my $palette)=i_readgif(fileno(FH)); - ok($img, "read palette") or die "Cannot read testout/t105.gif\n"; - close(FH); - - $palette=''; # just to skip a warning. - - # check that reading interlaced/non-interlaced versions of - # the same GIF produce the same image - # I could replace this with code that used Imager's built-in - # image comparison code, but I know this code revealed the error - open(FH, "testout/t105i.ppm" or die "Cannot create testout/t105i.ppm"; - binmode FH; - my $IO = Imager::io_new_fd( fileno(FH) ); - i_writeppm_wiol($imgi, $IO) - or die "Cannot write testout/t105i.ppm"; - close FH; - - open FH, ">testout/t105ni.ppm" or die "Cannot create testout/t105ni.ppm"; - binmode FH; - $IO = Imager::io_new_fd( fileno(FH) ); - i_writeppm_wiol($imgni, $IO) - or die "Cannot write testout/t105ni.ppm"; - close FH; - - # compare them - open FH, " }; - close FH; - - open FH, " }; - close FH; - is($datai, $datani, "images match"); - - SKIP: - { - skip("giflib3 doesn't support callbacks", 4) unless $gifver >= 4.0; - # reading with a callback - # various sizes to make sure the buffering works - # requested size - open FH, "testout/t105_mc.gif" or die "Cannot open testout/t105_mc.gif"; - binmode FH; - ok(i_writegifmc($img, fileno(FH), 7), "writegifmc"); - close(FH); - - # new writegif_gen - # test webmap, custom errdiff map - # (looks fairly awful) - open FH, ">testout/t105_gen.gif" or die $!; - binmode FH; - ok(i_writegif_gen(fileno(FH), { make_colors=>'webmap', - translate=>'errdiff', - errdiff=>'custom', - errdiff_width=>2, - errdiff_height=>2, - errdiff_map=>[0, 1, 1, 0]}, $img), + skip("giflib3 doesn't support callbacks", 4) unless $gifver >= 4.0; + # reading with a callback + # various sizes to make sure the buffering works + # requested size + open FH, "testout/t105_mc.gif" or die "Cannot open testout/t105_mc.gif"; +binmode FH; +ok(i_writegifmc($img, fileno(FH), 7), "writegifmc"); +close(FH); + +# new writegif_gen +# test webmap, custom errdiff map +# (looks fairly awful) +open FH, ">testout/t105_gen.gif" or die $!; +binmode FH; +ok(i_writegif_gen(fileno(FH), { make_colors=>'webmap', + translate=>'errdiff', + errdiff=>'custom', + errdiff_width=>2, + errdiff_height=>2, + errdiff_map=>[0, 1, 1, 0]}, $img), "webmap, custom errdif map"); - close FH; - - print "# the following tests are fairly slow\n"; - - # test animation, mc_addi, error diffusion, ordered transparency - my @imgs; - my $sortagreen = i_color_new(0, 255, 0, 63); - for my $i (0..4) { - my $im = Imager::ImgRaw::new(200, 200, 4); - _add_tags($im, gif_delay=>50, gif_disposal=>2); - for my $j (0..$i-1) { - my $fill = i_color_new(0, 128, 0, 255 * ($i-$j)/$i); - i_box_filled($im, 0, $j*40, 199, $j*40+40, $fill); - } - i_box_filled($im, 0, $i*40, 199, 199, $blue); - push(@imgs, $im); - } - my @gif_delays = (50) x 5; - my @gif_disposal = (2) x 5; - open FH, ">testout/t105_anim.gif" or die $!; - binmode FH; - ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', - translate=>'closest', - gif_delays=>\@gif_delays, - gif_disposal=>\@gif_disposal, - gif_positions=> [ map [ $_*10, $_*10 ], 0..4 ], - gif_user_input=>[ 1, 0, 1, 0, 1 ], - transp=>'ordered', - 'tr_orddith'=>'dot8'}, @imgs), - "write anim gif"); - close FH; - - my $can_write_callback = 0; - unlink $buggy_giflib_file; - SKIP: - { - skip("giflib3 doesn't support callbacks", 1) unless $gifver >= 4.0; - ++$can_write_callback; - my $good = ext_test(14, <<'ENDOFCODE'); +close FH; + +print "# the following tests are fairly slow\n"; + +# test animation, mc_addi, error diffusion, ordered transparency +my @imgs; +my $sortagreen = i_color_new(0, 255, 0, 63); +for my $i (0..4) { + my $im = Imager::ImgRaw::new(200, 200, 4); + _add_tags($im, gif_delay=>50, gif_disposal=>2); + for my $j (0..$i-1) { + my $fill = i_color_new(0, 128, 0, 255 * ($i-$j)/$i); + i_box_filled($im, 0, $j*40, 199, $j*40+40, $fill); + } + i_box_filled($im, 0, $i*40, 199, 199, $blue); + push(@imgs, $im); +} +my @gif_delays = (50) x 5; +my @gif_disposal = (2) x 5; +open FH, ">testout/t105_anim.gif" or die $!; +binmode FH; +ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', + translate=>'closest', + gif_delays=>\@gif_delays, + gif_disposal=>\@gif_disposal, + gif_positions=> [ map [ $_*10, $_*10 ], 0..4 ], + gif_user_input=>[ 1, 0, 1, 0, 1 ], + transp=>'ordered', + 'tr_orddith'=>'dot8'}, @imgs), + "write anim gif"); +close FH; + +my $can_write_callback = 0; +unlink $buggy_giflib_file; +SKIP: +{ + skip("giflib3 doesn't support callbacks", 1) unless $gifver >= 4.0; + ++$can_write_callback; + my $good = ext_test(14, <<'ENDOFCODE'); use Imager qw(:all); use Imager::Test qw(test_image_raw); my $timg = test_image_raw(); @@ -211,13 +192,13 @@ close FH; print "ok 14\n"; exit; ENDOFCODE - unless ($good) { - $can_write_callback = 0; - fail("see $buggy_giflib_file"); - print STDERR "\nprobable buggy giflib - skipping tests that depend on a good giflib\n"; - print STDERR "see $buggy_giflib_file for more information\n"; - open FLAG, "> $buggy_giflib_file" or die; - print FLAG < $buggy_giflib_file" or die; + print FLAG <1, gif_delay=>150, gif_loop=>10); - for my $x (0 .. 39) { - for my $y (0 .. 39) { - $c->set($x * 6, $y * 6, 32*$g+$x+$y, 255); - i_box_filled($im, $x*5, $y*5, $x*5+4, $y*5+4, $c); - } - } - push(@imgs, $im); - } - # test giflib with multiple palettes - # (it was meant to test the NS loop extension too, but that's broken) - # this looks better with make_colors=>'addi', translate=>'errdiff' - # this test aims to overload the palette for each image, so the - # output looks moderately horrible - open FH, ">testout/t105_mult_pall.gif" or die "Cannot create file: $!"; - binmode FH; - ok(i_writegif_gen(fileno(FH), { #make_colors=>'webmap', - translate=>'giflib', - }, @imgs), "write multiple palettes") - or print "# ", join(":", map $_->[1], Imager::i_errors()),"\n"; - close FH; - - # regression test: giflib doesn't like 1 colour images - my $img1 = Imager::ImgRaw::new(100, 100, 3); - i_box_filled($img1, 0, 0, 100, 100, $red); - open FH, ">testout/t105_onecol.gif" or die $!; - binmode FH; - ok(i_writegif_gen(fileno(FH), { translate=>'giflib'}, $img1), - "single colour write regression"); - close FH; - - # transparency test - # previously it was harder do write transparent images - # tests the improvements - my $timg = Imager::ImgRaw::new(20, 20, 4); - my $trans = i_color_new(255, 0, 0, 127); - i_box_filled($timg, 0, 0, 20, 20, $green); - i_box_filled($timg, 2, 2, 18, 18, $trans); - open FH, ">testout/t105_trans.gif" or die $!; - binmode FH; - ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', - translate=>'closest', - transp=>'ordered', - }, $timg), "write transparent"); - close FH; - - # some error handling tests - # open a file handle for read and try to save to it - # is this idea portable? - # whether or not it is, giflib segfaults on this - #open FH, "testout/t105_none.gif" - or die "Cannot open testout/t105_none.gif: $!"; - binmode FH; - if (ok(!i_writegif_gen(fileno(FH), {}, "hello"), "shouldn't be able to write a string as a gif")) { - print "# ",Imager::_error_as_msg(),"\n"; + } +} +@imgs = (); +my $c = i_color_new(0,0,0,0); +for my $g (0..3) { + my $im = Imager::ImgRaw::new(200, 200, 3); + _add_tags($im, gif_local_map=>1, gif_delay=>150, gif_loop=>10); + for my $x (0 .. 39) { + for my $y (0 .. 39) { + $c->set($x * 6, $y * 6, 32*$g+$x+$y, 255); + i_box_filled($im, $x*5, $y*5, $x*5+4, $y*5+4, $c); } + } + push(@imgs, $im); +} +# test giflib with multiple palettes +# (it was meant to test the NS loop extension too, but that's broken) +# this looks better with make_colors=>'addi', translate=>'errdiff' +# this test aims to overload the palette for each image, so the +# output looks moderately horrible +open FH, ">testout/t105_mult_pall.gif" or die "Cannot create file: $!"; +binmode FH; +ok(i_writegif_gen(fileno(FH), { #make_colors=>'webmap', + translate=>'giflib', + }, @imgs), "write multiple palettes") + or print "# ", join(":", map $_->[1], Imager::i_errors()),"\n"; +close FH; - # try to read a truncated gif (no image descriptors) - read_failure('testimg/trimgdesc.gif'); - # file truncated just after the image descriptor tag - read_failure('testimg/trmiddesc.gif'); - # image has no colour map - read_failure('testimg/nocmap.gif'); - - SKIP: - { - skip("see $buggy_giflib_file", 18) if -e $buggy_giflib_file; - # image has a local colour map - open FH, "< testimg/loccmap.gif" - or die "Cannot open testimg/loccmap.gif: $!"; - binmode FH; - ok(i_readgif(fileno(FH)), "read an image with only a local colour map"); - close FH; +# regression test: giflib doesn't like 1 colour images +my $img1 = Imager::ImgRaw::new(100, 100, 3); +i_box_filled($img1, 0, 0, 100, 100, $red); +open FH, ">testout/t105_onecol.gif" or die $!; +binmode FH; +ok(i_writegif_gen(fileno(FH), { translate=>'giflib'}, $img1), + "single colour write regression"); +close FH; - # image has global and local colour maps - open FH, "< testimg/screen2.gif" - or die "Cannot open testimg/screen2.gif: $!"; - binmode FH; - my $ims = i_readgif(fileno(FH)); - unless (ok($ims, "read an image with global and local colour map")) { - print "# ",Imager::_error_as_msg(),"\n"; - } - close FH; +# transparency test +# previously it was harder do write transparent images +# tests the improvements +my $timg = Imager::ImgRaw::new(20, 20, 4); +my $trans = i_color_new(255, 0, 0, 127); +i_box_filled($timg, 0, 0, 20, 20, $green); +i_box_filled($timg, 2, 2, 18, 18, $trans); +open FH, ">testout/t105_trans.gif" or die $!; +binmode FH; +ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', + translate=>'closest', + transp=>'ordered', + }, $timg), "write transparent"); +close FH; - open FH, "< testimg/expected.gif" - or die "Cannot open testimg/expected.gif: $!"; - binmode FH; - my $ime = i_readgif(fileno(FH)); - close FH; - ok($ime, "reading testimg/expected.gif"); - SKIP: - { - skip("could not read one or both of expected.gif or loccamp.gif", 1) - unless $ims and $ime; - unless (is(i_img_diff($ime, $ims), 0, - "compare loccmap and expected")) { - # save the bad one - open FH, "> testout/t105_screen2.gif" - or die "Cannot create testout/t105_screen.gif: $!"; - binmode FH; - i_writegifmc($ims, fileno(FH), 7) - or print "# could not save t105_screen.gif\n"; - close FH; - } - } +# some error handling tests +# open a file handle for read and try to save to it +# is this idea portable? +# whether or not it is, giflib segfaults on this +#open FH, "[0] eq 'gif_left', @tags; - ok($left && $left->[1] == 3, "check gif_left value"); - - # screen3.gif was saved with - open FH, "< testimg/screen3.gif" - or die "Cannot open testimg/screen3.gif: $!"; - binmode FH; - @imgs = Imager::i_readgif_multi(fileno(FH)); - ok(@imgs, "read screen3.gif"); - close FH; - eval { - require 'Data/Dumper.pm'; - Data::Dumper->import(); - }; - unless ($@) { - # build a big map of all tags for all images - @tags = - map { - my $im = $_; - [ - map { join ",", map { defined() ? $_ : "undef" } Imager::i_tags_get($im, $_) } - 0..Imager::i_tags_count($_)-1 - ] - } @imgs; - my $dump = Dumper(\@tags); - $dump =~ s/^/# /mg; - print "# tags from gif\n", $dump; - } - - # at this point @imgs should contain only paletted images - ok(Imager::i_img_type($imgs[0]) == 1, "imgs[0] paletted"); - ok(Imager::i_img_type($imgs[1]) == 1, "imgs[1] paletted"); - - # see how we go saving it - open FH, ">testout/t105_pal.gif" or die $!; +# try to save no images :) +open FH, ">testout/t105_none.gif" + or die "Cannot open testout/t105_none.gif: $!"; +binmode FH; +if (ok(!i_writegif_gen(fileno(FH), {}, "hello"), "shouldn't be able to write a string as a gif")) { + print "# ",Imager::_error_as_msg(),"\n"; +} + +# try to read a truncated gif (no image descriptors) +read_failure('testimg/trimgdesc.gif'); +# file truncated just after the image descriptor tag +read_failure('testimg/trmiddesc.gif'); +# image has no colour map +read_failure('testimg/nocmap.gif'); + +SKIP: +{ + skip("see $buggy_giflib_file", 18) if -e $buggy_giflib_file; + # image has a local colour map + open FH, "< testimg/loccmap.gif" + or die "Cannot open testimg/loccmap.gif: $!"; + binmode FH; + ok(i_readgif(fileno(FH)), "read an image with only a local colour map"); + close FH; + + # image has global and local colour maps + open FH, "< testimg/screen2.gif" + or die "Cannot open testimg/screen2.gif: $!"; + binmode FH; + my $ims = i_readgif(fileno(FH)); + unless (ok($ims, "read an image with global and local colour map")) { + print "# ",Imager::_error_as_msg(),"\n"; + } + close FH; + + open FH, "< testimg/expected.gif" + or die "Cannot open testimg/expected.gif: $!"; + binmode FH; + my $ime = i_readgif(fileno(FH)); + close FH; + ok($ime, "reading testimg/expected.gif"); + SKIP: + { + skip("could not read one or both of expected.gif or loccamp.gif", 1) + unless $ims and $ime; + unless (is(i_img_diff($ime, $ims), 0, + "compare loccmap and expected")) { + # save the bad one + open FH, "> testout/t105_screen2.gif" + or die "Cannot create testout/t105_screen.gif: $!"; binmode FH; - ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', - translate=>'closest', - transp=>'ordered', - }, @imgs), "write from paletted"); + i_writegifmc($ims, fileno(FH), 7) + or print "# could not save t105_screen.gif\n"; close FH; - - # make sure nothing bad happened - open FH, "< testout/t105_pal.gif" or die $!; - binmode FH; - ok((my @imgs2 = Imager::i_readgif_multi(fileno(FH))) == 2, - "re-reading saved paletted images"); - ok(i_img_diff($imgs[0], $imgs2[0]) == 0, "imgs[0] mismatch"); - ok(i_img_diff($imgs[1], $imgs2[1]) == 0, "imgs[1] mismatch"); } - - # test that the OO interface warns when we supply old options - { - my @warns; - local $SIG{__WARN__} = sub { push(@warns, "@_") }; - - my $ooim = Imager->new; - ok($ooim->read(file=>"testout/t105.gif"), "read into object"); - ok($ooim->write(file=>"testout/t105_warn.gif", interlace=>1), - "save from object") - or print "# ", $ooim->errstr, "\n"; - ok(grep(/Obsolete .* interlace .* gif_interlace/, @warns), - "check for warning"); - init(warn_obsolete=>0); - @warns = (); - ok($ooim->write(file=>"testout/t105_warn.gif", interlace=>1), - "save from object"); - ok(!grep(/Obsolete .* interlace .* gif_interlace/, @warns), - "check for warning"); + } + + # test reading a multi-image file into multiple images + open FH, "< testimg/screen2.gif" + or die "Cannot open testimg/screen2.gif: $!"; + binmode FH; + @imgs = Imager::i_readgif_multi(fileno(FH)); + ok(@imgs, "read multi-image file into multiple images"); + close FH; + is(@imgs, 2, "should be 2 images"); + my $paletted = 1; + for my $img (@imgs) { + unless (Imager::i_img_type($img) == 1) { + $paletted = 0; + last; } + } + ok($paletted, "both images should be paletted"); + is(Imager::i_colorcount($imgs[0]), 4, "4 colours in first image"); + is(Imager::i_colorcount($imgs[1]), 2, "2 colours in second image"); + ok(Imager::i_tags_find($imgs[0], "gif_left", 0), + "gif_left tag should be there"); + my @tags = map {[ Imager::i_tags_get($imgs[1], $_) ]} 0..Imager::i_tags_count($imgs[1])-1; + my ($left) = grep $_->[0] eq 'gif_left', @tags; + ok($left && $left->[1] == 3, "check gif_left value"); + + # screen3.gif was saved with + open FH, "< testimg/screen3.gif" + or die "Cannot open testimg/screen3.gif: $!"; + binmode FH; + @imgs = Imager::i_readgif_multi(fileno(FH)); + ok(@imgs, "read screen3.gif"); + close FH; + eval { + require 'Data/Dumper.pm'; + Data::Dumper->import(); + }; + unless ($@) { + # build a big map of all tags for all images + @tags = + map { + my $im = $_; + [ + map { join ",", map { defined() ? $_ : "undef" } Imager::i_tags_get($im, $_) } + 0..Imager::i_tags_count($_)-1 + ] + } @imgs; + my $dump = Dumper(\@tags); + $dump =~ s/^/# /mg; + print "# tags from gif\n", $dump; + } + + # at this point @imgs should contain only paletted images + ok(Imager::i_img_type($imgs[0]) == 1, "imgs[0] paletted"); + ok(Imager::i_img_type($imgs[1]) == 1, "imgs[1] paletted"); + + # see how we go saving it + open FH, ">testout/t105_pal.gif" or die $!; + binmode FH; + ok(i_writegif_gen(fileno(FH), { make_colors=>'addi', + translate=>'closest', + transp=>'ordered', + }, @imgs), "write from paletted"); + close FH; + + # make sure nothing bad happened + open FH, "< testout/t105_pal.gif" or die $!; + binmode FH; + ok((my @imgs2 = Imager::i_readgif_multi(fileno(FH))) == 2, + "re-reading saved paletted images"); + ok(i_img_diff($imgs[0], $imgs2[0]) == 0, "imgs[0] mismatch"); + ok(i_img_diff($imgs[1], $imgs2[1]) == 0, "imgs[1] mismatch"); +} - # test that we get greyscale from 1 channel images - # we check for each makemap, and for each translate - print "# test writes of grayscale images - ticket #365\n"; - my $ooim = Imager->new(xsize=>50, ysize=>50, channels=>1); - for (my $y = 0; $y < 50; $y += 10) { - $ooim->box(box=>[ 0, $y, 49, $y+9], color=>NC($y*5,0,0), filled=>1); - } - my $ooim3 = $ooim->convert(preset=>'rgb'); - #$ooim3->write(file=>'testout/t105gray.ppm'); - my %maxerror = ( mediancut => 51000, - addi => 0, - closest => 0, - perturb => 0, - errdiff => 0 ); - for my $makemap (qw(mediancut addi)) { - print "# make_colors => $makemap\n"; - ok( $ooim->write(file=>"testout/t105gray-$makemap.gif", - make_colors=>$makemap, - gifquant=>'gen'), - "writing gif with makemap $makemap"); - my $im2 = Imager->new; - if (ok($im2->read(file=>"testout/t105gray-$makemap.gif"), - "reading written grayscale gif")) { - my $diff = i_img_diff($ooim3->{IMG}, $im2->{IMG}); - ok($diff <= $maxerror{$makemap}, "comparing images $diff"); - #$im2->write(file=>"testout/t105gray-$makemap.ppm"); - } - else { - SKIP: { skip("could not get test image", 1); } - } - } - for my $translate (qw(closest perturb errdiff)) { - print "# translate => $translate\n"; - my @colors = map NC($_*50, $_*50, $_*50), 0..4; - ok($ooim->write(file=>"testout/t105gray-$translate.gif", - translate=>$translate, - make_colors=>'none', - colors=>\@colors, - gifquant=>'gen'), - "writing gif with translate $translate"); - my $im2 = Imager->new; - if (ok($im2->read(file=>"testout/t105gray-$translate.gif"), - "reading written grayscale gif")) { - my $diff = i_img_diff($ooim3->{IMG}, $im2->{IMG}); - ok($diff <= $maxerror{$translate}, "comparing images $diff"); - #$im2->write(file=>"testout/t105gray-$translate.ppm"); - } - else { - SKIP: { skip("could not load test image", 1) } - } +# test that the OO interface warns when we supply old options +{ + my @warns; + local $SIG{__WARN__} = sub { push(@warns, "@_") }; + + my $ooim = Imager->new; + ok($ooim->read(file=>"testout/t105.gif"), "read into object"); + ok($ooim->write(file=>"testout/t105_warn.gif", interlace=>1), + "save from object") + or print "# ", $ooim->errstr, "\n"; + ok(grep(/Obsolete .* interlace .* gif_interlace/, @warns), + "check for warning"); + init(warn_obsolete=>0); + @warns = (); + ok($ooim->write(file=>"testout/t105_warn.gif", interlace=>1), + "save from object"); + ok(!grep(/Obsolete .* interlace .* gif_interlace/, @warns), + "check for warning"); +} + +# test that we get greyscale from 1 channel images +# we check for each makemap, and for each translate +print "# test writes of grayscale images - ticket #365\n"; +my $ooim = Imager->new(xsize=>50, ysize=>50, channels=>1); +for (my $y = 0; $y < 50; $y += 10) { + $ooim->box(box=>[ 0, $y, 49, $y+9], color=>NC($y*5,0,0), filled=>1); +} +my $ooim3 = $ooim->convert(preset=>'rgb'); +#$ooim3->write(file=>'testout/t105gray.ppm'); +my %maxerror = ( mediancut => 51000, + addi => 0, + closest => 0, + perturb => 0, + errdiff => 0 ); +for my $makemap (qw(mediancut addi)) { + print "# make_colors => $makemap\n"; + ok( $ooim->write(file=>"testout/t105gray-$makemap.gif", + make_colors=>$makemap, + gifquant=>'gen'), + "writing gif with makemap $makemap"); + my $im2 = Imager->new; + if (ok($im2->read(file=>"testout/t105gray-$makemap.gif"), + "reading written grayscale gif")) { + my $diff = i_img_diff($ooim3->{IMG}, $im2->{IMG}); + ok($diff <= $maxerror{$makemap}, "comparing images $diff"); + #$im2->write(file=>"testout/t105gray-$makemap.ppm"); + } + else { + SKIP: { skip("could not get test image", 1); } + } +} +for my $translate (qw(closest perturb errdiff)) { + print "# translate => $translate\n"; + my @colors = map NC($_*50, $_*50, $_*50), 0..4; + ok($ooim->write(file=>"testout/t105gray-$translate.gif", + translate=>$translate, + make_colors=>'none', + colors=>\@colors, + gifquant=>'gen'), + "writing gif with translate $translate"); + my $im2 = Imager->new; + if (ok($im2->read(file=>"testout/t105gray-$translate.gif"), + "reading written grayscale gif")) { + my $diff = i_img_diff($ooim3->{IMG}, $im2->{IMG}); + ok($diff <= $maxerror{$translate}, "comparing images $diff"); + #$im2->write(file=>"testout/t105gray-$translate.ppm"); + } + else { + SKIP: { skip("could not load test image", 1) } + } } - # try to write an image with no colors - should error - ok(!$ooim->write(file=>"testout/t105nocolors.gif", - make_colors=>'none', - colors=>[], gifquant=>'gen'), - "write with no colors"); - - # try to write multiple with no colors, with separate maps - # I don't see a way to test this, since we don't have a mechanism - # to give the second image different quant options, we can't trigger - # a failure just for the second image - - # check that the i_format tag is set for both multiple and single - # image reads - { - my @anim = Imager->read_multi(file=>"testout/t105_anim.gif"); - ok(@anim == 5, "check we got all the images"); - for my $frame (@anim) { - my ($type) = $frame->tags(name=>'i_format'); - is($type, 'gif', "check i_format for animation frame"); - } +# try to write an image with no colors - should error +ok(!$ooim->write(file=>"testout/t105nocolors.gif", + make_colors=>'none', + colors=>[], gifquant=>'gen'), + "write with no colors"); - my $im = Imager->new; - ok($im->read(file=>"testout/t105.gif"), "read some gif"); - my ($type) = $im->tags(name=>'i_format'); - is($type, 'gif', 'check i_format for single image read'); - } +# try to write multiple with no colors, with separate maps +# I don't see a way to test this, since we don't have a mechanism +# to give the second image different quant options, we can't trigger +# a failure just for the second image - { # check file limits are checked - my $limit_file = "testout/t105.gif"; - 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); +# check that the i_format tag is set for both multiple and single +# image reads +{ + my @anim = Imager->read_multi(file=>"testout/t105_anim.gif"); + ok(@anim == 5, "check we got all the images"); + for my $frame (@anim) { + my ($type) = $frame->tags(name=>'i_format'); + is($type, 'gif', "check i_format for animation frame"); } + + my $im = Imager->new; + ok($im->read(file=>"testout/t105.gif"), "read some gif"); + my ($type) = $im->tags(name=>'i_format'); + is($type, 'gif', 'check i_format for single image read'); +} - { - print "# test OO interface reading of consolidated images\n"; - my $im = Imager->new; - ok($im->read(file=>'testimg/screen2.gif', gif_consolidate=>1), - "read image to consolidate"); - my $expected = Imager->new; - ok($expected->read(file=>'testimg/expected.gif'), - "read expected via OO"); - is(i_img_diff($im->{IMG}, $expected->{IMG}), 0, - "compare them"); - - # check the default read doesn't match - ok($im->read(file=>'testimg/screen2.gif'), - "read same image without consolidate"); - isnt(i_img_diff($im->{IMG}, $expected->{IMG}), 0, +{ # check file limits are checked + my $limit_file = "testout/t105.gif"; + 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); +} + +{ + print "# test OO interface reading of consolidated images\n"; + my $im = Imager->new; + ok($im->read(file=>'testimg/screen2.gif', gif_consolidate=>1), + "read image to consolidate"); + my $expected = Imager->new; + ok($expected->read(file=>'testimg/expected.gif'), + "read expected via OO"); + is(i_img_diff($im->{IMG}, $expected->{IMG}), 0, + "compare them"); + + # check the default read doesn't match + ok($im->read(file=>'testimg/screen2.gif'), + "read same image without consolidate"); + isnt(i_img_diff($im->{IMG}, $expected->{IMG}), 0, "compare them - shouldn't include the overlayed second image"); - } - { - print "# test the reading of single pages\n"; - # build a test file - my $test_file = 'testout/t105_multi_sing.gif'; - my $im1 = Imager->new(xsize=>100, ysize=>100); - $im1->box(filled=>1, color=>$blue); - $im1->addtag(name=>'gif_left', value=>10); - $im1->addtag(name=>'gif_top', value=>15); - $im1->addtag(name=>'gif_comment', value=>'First page'); - my $im2 = Imager->new(xsize=>50, ysize=>50); - $im2->box(filled=>1, color=>$red); - $im2->addtag(name=>'gif_left', value=>30); - $im2->addtag(name=>'gif_top', value=>25); - $im2->addtag(name=>'gif_comment', value=>'Second page'); - my $im3 = Imager->new(xsize=>25, ysize=>25); - $im3->box(filled=>1, color=>$green); - $im3->addtag(name=>'gif_left', value=>35); - $im3->addtag(name=>'gif_top', value=>45); - # don't set comment for $im3 - ok(Imager->write_multi({ file=> $test_file}, $im1, $im2, $im3), - "write test file for single page reads"); - - my $res = Imager->new; - # check we get the first image - ok($res->read(file=>$test_file), "read default (first) page"); - is(i_img_diff($im1->{IMG}, $res->{IMG}), 0, "compare against first"); - # check tags - is($res->tags(name=>'gif_left'), 10, "gif_left"); - is($res->tags(name=>'gif_top'), 15, "gif_top"); - is($res->tags(name=>'gif_comment'), 'First page', "gif_comment"); - - # get the second image - ok($res->read(file=>$test_file, page=>1), "read second page") - or print "# ",$res->errstr, "\n"; - is(i_img_diff($im2->{IMG}, $res->{IMG}), 0, "compare against second"); - # check tags - is($res->tags(name=>'gif_left'), 30, "gif_left"); - is($res->tags(name=>'gif_top'), 25, "gif_top"); - is($res->tags(name=>'gif_comment'), 'Second page', "gif_comment"); - - # get the third image - ok($res->read(file=>$test_file, page=>2), "read third page") - or print "# ",$res->errstr, "\n"; - is(i_img_diff($im3->{IMG}, $res->{IMG}), 0, "compare against third"); - is($res->tags(name=>'gif_left'), 35, "gif_left"); - is($res->tags(name=>'gif_top'), 45, "gif_top"); - is($res->tags(name=>'gif_comment'), undef, 'gif_comment undef'); - - # try to read a fourth page +} +{ + print "# test the reading of single pages\n"; + # build a test file + my $test_file = 'testout/t105_multi_sing.gif'; + my $im1 = Imager->new(xsize=>100, ysize=>100); + $im1->box(filled=>1, color=>$blue); + $im1->addtag(name=>'gif_left', value=>10); + $im1->addtag(name=>'gif_top', value=>15); + $im1->addtag(name=>'gif_comment', value=>'First page'); + my $im2 = Imager->new(xsize=>50, ysize=>50); + $im2->box(filled=>1, color=>$red); + $im2->addtag(name=>'gif_left', value=>30); + $im2->addtag(name=>'gif_top', value=>25); + $im2->addtag(name=>'gif_comment', value=>'Second page'); + my $im3 = Imager->new(xsize=>25, ysize=>25); + $im3->box(filled=>1, color=>$green); + $im3->addtag(name=>'gif_left', value=>35); + $im3->addtag(name=>'gif_top', value=>45); + # don't set comment for $im3 + ok(Imager->write_multi({ file=> $test_file}, $im1, $im2, $im3), + "write test file for single page reads"); + + my $res = Imager->new; + # check we get the first image + ok($res->read(file=>$test_file), "read default (first) page"); + is(i_img_diff($im1->{IMG}, $res->{IMG}), 0, "compare against first"); + # check tags + is($res->tags(name=>'gif_left'), 10, "gif_left"); + is($res->tags(name=>'gif_top'), 15, "gif_top"); + is($res->tags(name=>'gif_comment'), 'First page', "gif_comment"); + + # get the second image + ok($res->read(file=>$test_file, page=>1), "read second page") + or print "# ",$res->errstr, "\n"; + is(i_img_diff($im2->{IMG}, $res->{IMG}), 0, "compare against second"); + # check tags + is($res->tags(name=>'gif_left'), 30, "gif_left"); + is($res->tags(name=>'gif_top'), 25, "gif_top"); + is($res->tags(name=>'gif_comment'), 'Second page', "gif_comment"); + + # get the third image + ok($res->read(file=>$test_file, page=>2), "read third page") + or print "# ",$res->errstr, "\n"; + is(i_img_diff($im3->{IMG}, $res->{IMG}), 0, "compare against third"); + is($res->tags(name=>'gif_left'), 35, "gif_left"); + is($res->tags(name=>'gif_top'), 45, "gif_top"); + is($res->tags(name=>'gif_comment'), undef, 'gif_comment undef'); + + # try to read a fourth page ok(!$res->read(file=>$test_file, page=>3), "fail reading fourth page"); - cmp_ok($res->errstr, "=~", 'page 3 not found', - "check error message"); - } + cmp_ok($res->errstr, "=~", 'page 3 not found', + "check error message"); +} SKIP: - { - skip("gif_loop not supported on giflib before 4.1", 6) - unless $gifver >= 4.1; - # testing writing the loop extension - my $im1 = Imager->new(xsize => 100, ysize => 100); - $im1->box(filled => 1, color => '#FF0000'); - my $im2 = Imager->new(xsize => 100, ysize => 100); - $im2->box(filled => 1, color => '#00FF00'); - ok(Imager->write_multi({ - gif_loop => 5, - gif_delay => 50, - file => 'testout/t105loop.gif' - }, $im1, $im2), - "write with loop extension"); - - my @im = Imager->read_multi(file => 'testout/t105loop.gif'); - is(@im, 2, "read loop images back"); - is($im[0]->tags(name => 'gif_loop'), 5, "first loop read back"); - is($im[1]->tags(name => 'gif_loop'), 5, "second loop read back"); - is($im[0]->tags(name => 'gif_delay'), 50, "first delay read back"); - is($im[1]->tags(name => 'gif_delay'), 50, "second delay read back"); - } - SKIP: - { # check graphic control extension and ns loop tags are read correctly - print "# check GCE and netscape loop extension tag values\n"; - my @im = Imager->read_multi(file => 'testimg/screen3.gif'); - is(@im, 2, "read 2 images from screen3.gif") - or skip("Could not load testimg/screen3.gif:".Imager->errstr, 11); - is($im[0]->tags(name => 'gif_delay'), 50, "0 - gif_delay"); - is($im[0]->tags(name => 'gif_disposal'), 2, "0 - gif_disposal"); - is($im[0]->tags(name => 'gif_trans_index'), undef, "0 - gif_trans_index"); - is($im[0]->tags(name => 'gif_user_input'), 0, "0 - gif_user_input"); - is($im[0]->tags(name => 'gif_loop'), 0, "0 - gif_loop"); - is($im[1]->tags(name => 'gif_delay'), 50, "1 - gif_delay"); - is($im[1]->tags(name => 'gif_disposal'), 2, "1 - gif_disposal"); - is($im[1]->tags(name => 'gif_trans_index'), 7, "1 - gif_trans_index"); - is($im[1]->tags(name => 'gif_trans_color'), 'color(255,255,255,0)', - "1 - gif_trans_index"); - is($im[1]->tags(name => 'gif_user_input'), 0, "1 - gif_user_input"); - is($im[1]->tags(name => 'gif_loop'), 0, "1 - gif_loop"); - } +{ + skip("gif_loop not supported on giflib before 4.1", 6) + unless $gifver >= 4.1; + # testing writing the loop extension + my $im1 = Imager->new(xsize => 100, ysize => 100); + $im1->box(filled => 1, color => '#FF0000'); + my $im2 = Imager->new(xsize => 100, ysize => 100); + $im2->box(filled => 1, color => '#00FF00'); + ok(Imager->write_multi({ + gif_loop => 5, + gif_delay => 50, + file => 'testout/t105loop.gif' + }, $im1, $im2), + "write with loop extension"); + + my @im = Imager->read_multi(file => 'testout/t105loop.gif'); + is(@im, 2, "read loop images back"); + is($im[0]->tags(name => 'gif_loop'), 5, "first loop read back"); + is($im[1]->tags(name => 'gif_loop'), 5, "second loop read back"); + is($im[0]->tags(name => 'gif_delay'), 50, "first delay read back"); + is($im[1]->tags(name => 'gif_delay'), 50, "second delay read back"); +} +SKIP: +{ # check graphic control extension and ns loop tags are read correctly + print "# check GCE and netscape loop extension tag values\n"; + my @im = Imager->read_multi(file => 'testimg/screen3.gif'); + is(@im, 2, "read 2 images from screen3.gif") + or skip("Could not load testimg/screen3.gif:".Imager->errstr, 11); + is($im[0]->tags(name => 'gif_delay'), 50, "0 - gif_delay"); + is($im[0]->tags(name => 'gif_disposal'), 2, "0 - gif_disposal"); + is($im[0]->tags(name => 'gif_trans_index'), undef, "0 - gif_trans_index"); + is($im[0]->tags(name => 'gif_user_input'), 0, "0 - gif_user_input"); + is($im[0]->tags(name => 'gif_loop'), 0, "0 - gif_loop"); + is($im[1]->tags(name => 'gif_delay'), 50, "1 - gif_delay"); + is($im[1]->tags(name => 'gif_disposal'), 2, "1 - gif_disposal"); + is($im[1]->tags(name => 'gif_trans_index'), 7, "1 - gif_trans_index"); + is($im[1]->tags(name => 'gif_trans_color'), 'color(255,255,255,0)', + "1 - gif_trans_index"); + is($im[1]->tags(name => 'gif_user_input'), 0, "1 - gif_user_input"); + is($im[1]->tags(name => 'gif_loop'), 0, "1 - gif_loop"); +} - { - # manually modified from a small gif, this had the palette - # size changed to half the size, leaving an index out of range - my $im = Imager->new; - ok($im->read(file => 'testimg/badindex.gif', type => 'gif'), - "read bad index gif") - or print "# ", $im->errstr, "\n"; - my @indexes = $im->getscanline('y' => 0, type => 'index'); - is_deeply(\@indexes, [ 0..4 ], "check for correct indexes"); - is($im->colorcount, 5, "check the palette was adjusted"); - is_color3($im->getpixel('y' => 0, x => 4), 0, 0, 0, - "check it was black added"); - is($im->tags(name => 'gif_colormap_size'), 4, 'color map size tag'); - } +{ + # manually modified from a small gif, this had the palette + # size changed to half the size, leaving an index out of range + my $im = Imager->new; + ok($im->read(file => 'testimg/badindex.gif', type => 'gif'), + "read bad index gif") + or print "# ", $im->errstr, "\n"; + my @indexes = $im->getscanline('y' => 0, type => 'index'); + is_deeply(\@indexes, [ 0..4 ], "check for correct indexes"); + is($im->colorcount, 5, "check the palette was adjusted"); + is_color3($im->getpixel('y' => 0, x => 4), 0, 0, 0, + "check it was black added"); + is($im->tags(name => 'gif_colormap_size'), 4, 'color map size tag'); +} - { - ok(grep($_ eq 'gif', Imager->read_types), "check gif in read types"); - ok(grep($_ eq 'gif', Imager->write_types), "check gif in write types"); - } +{ + ok(grep($_ eq 'gif', Imager->read_types), "check gif in read types"); + ok(grep($_ eq 'gif', Imager->write_types), "check gif in write types"); +} - { - # check screen tags handled correctly note the screen size - # supplied is larger than the box covered by the images - my $im1 = Imager->new(xsize => 10, ysize => 8); - $im1->settag(name => 'gif_top', value => 4); - $im1->settag(name => 'gif_screen_width', value => 18); - $im1->settag(name => 'gif_screen_height', value => 16); - my $im2 = Imager->new(xsize => 7, ysize => 10); - $im2->settag(name => 'gif_left', value => 3); - my @im = ( $im1, $im2 ); - - my $data; - ok(Imager->write_multi({ data => \$data, type => 'gif' }, @im), - "write with screen settings") - or print "# ", Imager->errstr, "\n"; - my @result = Imager->read_multi(data => $data); - is(@result, 2, "got 2 images back"); - is($result[0]->tags(name => 'gif_screen_width'), 18, - "check result screen width"); - is($result[0]->tags(name => 'gif_screen_height'), 16, - "check result screen height"); - is($result[0]->tags(name => 'gif_left'), 0, - "check first gif_left"); - is($result[0]->tags(name => 'gif_top'), 4, - "check first gif_top"); - is($result[1]->tags(name => 'gif_left'), 3, - "check second gif_left"); - is($result[1]->tags(name => 'gif_top'), 0, - "check second gif_top"); - } +{ + # check screen tags handled correctly note the screen size + # supplied is larger than the box covered by the images + my $im1 = Imager->new(xsize => 10, ysize => 8); + $im1->settag(name => 'gif_top', value => 4); + $im1->settag(name => 'gif_screen_width', value => 18); + $im1->settag(name => 'gif_screen_height', value => 16); + my $im2 = Imager->new(xsize => 7, ysize => 10); + $im2->settag(name => 'gif_left', value => 3); + my @im = ( $im1, $im2 ); + + my $data; + ok(Imager->write_multi({ data => \$data, type => 'gif' }, @im), + "write with screen settings") + or print "# ", Imager->errstr, "\n"; + my @result = Imager->read_multi(data => $data); + is(@result, 2, "got 2 images back"); + is($result[0]->tags(name => 'gif_screen_width'), 18, + "check result screen width"); + is($result[0]->tags(name => 'gif_screen_height'), 16, + "check result screen height"); + is($result[0]->tags(name => 'gif_left'), 0, + "check first gif_left"); + is($result[0]->tags(name => 'gif_top'), 4, + "check first gif_top"); + is($result[1]->tags(name => 'gif_left'), 3, + "check second gif_left"); + is($result[1]->tags(name => 'gif_top'), 0, + "check second gif_top"); +} - { # test colors array returns colors - my $data; - my $im = test_image(); - my @colors; - ok($im->write(data => \$data, - colors => \@colors, - make_colors => 'webmap', - translate => 'closest', - gifquant => 'gen', - type => 'gif'), - "write using webmap to check color table"); - is(@colors, 216, "should be 216 colors in the webmap"); - is_color3($colors[0], 0, 0, 0, "first should be 000000"); - is_color3($colors[1], 0, 0, 0x33, "second should be 000033"); - is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366"); - } +{ # test colors array returns colors + my $data; + my $im = test_image(); + my @colors; + ok($im->write(data => \$data, + colors => \@colors, + make_colors => 'webmap', + translate => 'closest', + gifquant => 'gen', + type => 'gif'), + "write using webmap to check color table"); + is(@colors, 216, "should be 216 colors in the webmap"); + is_color3($colors[0], 0, 0, 0, "first should be 000000"); + is_color3($colors[1], 0, 0, 0x33, "second should be 000033"); + is_color3($colors[8], 0, 0x33, 0x66, "9th should be 003366"); } sub test_readgif_cb { diff --git a/t/t105nogif.t b/t/t105nogif.t new file mode 100644 index 00000000..2021faa7 --- /dev/null +++ b/t/t105nogif.t @@ -0,0 +1,19 @@ +#!perl -w +use strict; +$|=1; +use Test::More; +use Imager qw(:all); + +i_has_format("gif") + and plan skip_all => "gif support available and this tests the lack of it"; + +plan tests => 6; + +my $im = Imager->new; +ok(!$im->read(file=>"testimg/scale.gif"), "should fail to read gif"); +cmp_ok($im->errstr, '=~', "format 'gif' not supported", "check no gif message"); +$im = Imager->new(xsize=>2, ysize=>2); +ok(!$im->write(file=>"testout/nogif.gif"), "should fail to write gif"); +cmp_ok($im->errstr, '=~', "format 'gif' not supported", "check no gif message"); +ok(!grep($_ eq 'gif', Imager->read_types), "check gif not in read types"); +ok(!grep($_ eq 'gif', Imager->write_types), "check gif not in write types"); -- 2.39.5