+#!perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..8\n"; }
+BEGIN { $| = 1; print "1..24\n"; }
END {print "not ok 1\n" unless $loaded;}
-use Imager;
+my $buggy_giflib_file = "buggy_giflib.txt";
+
+use Imager qw(:all :handy);
$loaded=1;
print "ok 1\n";
print "ok 2\n";
-$img->write(file=>'testout/t70newgif.gif',type=>'gif',gifplanes=>1,gifquant=>'lm',lmfixed=>[$green,$blue]) || print "failed: ",$img->{ERRSTR},"\n";
-print "ok 3\n";
-
-# make sure the palette is loaded properly (minimal test)
-my $im2 = Imager->new();
-my $map;
-if ($im2->read(file=>'testimg/bandw.gif', colors=>\$map)) {
- print "ok 4\n";
- # check the palette
- if ($map) {
- print "ok 5\n";
- if (@$map == 2) {
- print "ok 6\n";
- my @sorted = sort { comp_entry($a,$b) } @$map;
- # first entry must be #000000 and second #FFFFFF
- if (comp_entry($sorted[0], [0,0,0]) == 0) {
- print "ok 7\n";
- }
+if (i_has_format("gif")) {
+ $img->write(file=>'testout/t70newgif.gif',type=>'gif',gifplanes=>1,gifquant=>'lm',lmfixed=>[$green,$blue]) || print "failed: ",$img->{ERRSTR},"\nnot ";
+ print "ok 3\n";
+
+ # make sure the palette is loaded properly (minimal test)
+ my $im2 = Imager->new();
+ my $map;
+ if ($im2->read(file=>'testimg/bandw.gif', colors=>\$map)) {
+ print "ok 4\n";
+ # check the palette
+ if ($map) {
+ print "ok 5\n";
+ if (@$map == 2) {
+ print "ok 6\n";
+ my @sorted = sort { comp_entry($a,$b) } @$map;
+ # first entry must be #000000 and second #FFFFFF
+ if (comp_entry($sorted[0], NC(0,0,0)) == 0) {
+ print "ok 7\n";
+ }
+ else {
+ print "not ok 7 # entry should be black\n";
+ }
+ if (comp_entry($sorted[1], NC(255,255,255)) == 0) {
+ print "ok 8\n";
+ }
+ else {
+ print "not ok 8 # entry should be white\n";
+ }
+ }
else {
- print "not ok 7 # entry should be black\n";
+ print "not ok 6 # bad map size\n";
+ print "ok 7 # skipped bad map size\n";
+ print "ok 8 # skipped bad map size\n";
}
- if (comp_entry($sorted[1], [255,255,255]) == 0) {
- print "ok 8\n";
- }
- else {
- print "not ok 8 # entry should be white\n";
+ }
+ else {
+ print "not ok 5 # no map returned\n";
+ for (6..8) {
+ print "ok $_ # skipped no map returned\n";
}
}
+ }
+ else {
+ print "not ok 4 # ",$im2->errstr,"\n";
+ print "ok 5 # skipped - couldn't load image\n";
+ }
+
+ # test the read_multi interface
+ my @imgs = Imager->read_multi();
+ @imgs and print "not ";
+ print "ok 9\n";
+ Imager->errstr =~ /callback parameter missing/ or print "not ";
+ print "ok 10 # ",Imager->errstr,"\n";
+
+ @imgs = Imager->read_multi(type=>'gif');
+ @imgs and print "not ";
+ print "ok 11\n";
+ Imager->errstr =~ /file/ or print "not ";
+ print "ok 12 # ",Imager->errstr,"\n";
+ # kill warning
+ *NONESUCH = \20;
+ @imgs = Imager->read_multi(type=>'gif', fh=>*NONESUCH);
+ @imgs and print "not ";
+ print "ok 13\n";
+ Imager->errstr =~ /fh option not open/ or print "not ";
+ print "ok 14 # ",Imager->errstr,"\n";
+ unless (-e $buggy_giflib_file) {
+ @imgs = Imager->read_multi(type=>'gif', file=>'testimg/screen2.gif');
+ @imgs == 2 or print "not ";
+ print "ok 15\n";
+ grep(!UNIVERSAL::isa($_, 'Imager'), @imgs) and print "not ";
+ print "ok 16\n";
+ grep($_->type eq 'direct', @imgs) and print "not ";
+ print "ok 17\n";
+ (my @left = $imgs[0]->tags(name=>'gif_left')) == 1 or print "not ";
+ print "ok 18\n";
+ my $left = $imgs[1]->tags(name=>'gif_left') or print "not ";
+ print "ok 19\n";
+ $left == 3 or print "not ";
+ print "ok 20\n";
+ }
+ else {
+ for (15 .. 20) {
+ print "ok $_ # skip see $buggy_giflib_file\n";
+ }
+ }
+ if (Imager::i_giflib_version() >= 4.0) {
+ unless (-e $buggy_giflib_file) {
+ open FH, "< testimg/screen2.gif"
+ or die "Cannot open testimg/screen2.gif: $!";
+ binmode FH;
+ my $cb =
+ sub {
+ my $tmp;
+ read(FH, $tmp, $_[0]) and $tmp
+ };
+ @imgs = Imager->read_multi(type=>'gif',
+ callback => $cb) or print "not ";
+ print "ok 21\n";
+ close FH;
+ @imgs == 2 or print "not ";
+ print "ok 22\n";
+
+ open FH, "< testimg/screen2.gif"
+ or die "Cannot open testimg/screen2.gif: $!";
+ binmode FH;
+ my $data = do { local $/; <FH>; };
+ close FH;
+ @imgs = Imager->read_multi(type=>'gif',
+ data=>$data) or print "not ";
+ print "ok 23\n";
+ @imgs = 2 or print "not ";
+ print "ok 24\n";
+ }
else {
- print "not ok 6 # bad map size\n";
- print "ok 7 # skipped bad map size\n";
- print "ok 8 # skipped bad map size\n";
+ for (21..24) {
+ print "ok $_ # skip see $buggy_giflib_file\n";
+ }
}
}
else {
- print "not ok 5 # no map returned\n";
- for (6..8) {
- print "ok $_ # skipped no map returned\n";
+ for (21..24) {
+ print "ok $_ # skipped - giflib3 doesn't support callbacks\n";
}
}
}
else {
- print "not ok 4 # ",$im2->errstr,"\n";
- print "ok 5 # skipped - couldn't load image\n";
+ for (3..24) {
+ print "ok $_ # skipped: no gif support\n";
+ }
}
sub comp_entry {
my ($l, $r) = @_;
- return $l->[0] <=> $r->[0]
- || $l->[1] <=> $r->[1]
- || $l->[2] <=> $r->[2];
+ my @l = $l->rgba;
+ my @r = $r->rgba;
+ return $l[0] <=> $r[0]
+ || $l[1] <=> $r[1]
+ || $l[2] <=> $r[2];
}
projects / imager.git / blobdiff