1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!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'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
use strict;
use Test::More tests => 21;
use Imager qw(:all :handy);
use Imager::Test qw(test_image is_color3);
-d "testout" or mkdir "testout";
Imager::init('log'=>'testout/t70newgif.log');
my $green=i_color_new(0,255,0,0);
my $blue=i_color_new(0,0,255,0);
{
my $img = test_image();
ok($img->write(file=>'testout/t70newgif.gif',type=>'gif',gifplanes=>1,gifquant=>'lm',lmfixed=>[$green,$blue]))
or print "# failed: ",$img->{ERRSTR}, "\n";
}
SKIP:
{
# make sure the palette is loaded properly (minimal test)
my $im2 = Imager->new();
my $map;
ok($im2->read(file=>'testimg/bandw.gif', colors=>\$map))
or skip("Can't load bandw.gif", 5);
# check the palette
ok($map)
or skip("No palette", 4);
is(@$map, 2)
or skip("Bad map count", 3);
my @sorted = sort { comp_entry($a,$b) } @$map;
# first entry must be #000000 and second #FFFFFF
is_color3($sorted[0], 0,0,0, "check first palette entry");
is_color3($sorted[1], 255,255,255, "check second palette entry");
}
{
# test the read_multi interface
my @imgs = Imager->read_multi();
ok(!@imgs, "read with no sources should fail");
like(Imager->errstr, qr/callback parameter missing/, "check error");
print "# ",Imager->errstr,"\n";
@imgs = Imager->read_multi(type=>'gif');
ok(!@imgs, "read multi no source but type should fail");
like(Imager->errstr, qr/file/, "check error");
# kill warning
*NONESUCH = \20;
@imgs = Imager->read_multi(type=>'gif', fh=>*NONESUCH);
ok(!@imgs, "read from bad fh");
like(Imager->errstr, qr/fh option not open/, "check message");
print "# ",Imager->errstr,"\n";
{
@imgs = Imager->read_multi(type=>'gif', file=>'testimg/screen2.gif');
is(@imgs, 2, "should read 2 images");
isa_ok($imgs[0], "Imager");
isa_ok($imgs[1], "Imager");
is($imgs[0]->type, "paletted");
is($imgs[1]->type, "paletted");
my @left = $imgs[0]->tags(name=>'gif_left');
is(@left, 1);
my $left = $imgs[1]->tags(name=>'gif_left');
is($left, 3);
}
{
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);
close FH;
is(@imgs, 2, "read multi from callback");
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);
is(@imgs, 2, "read multi from data");
}
}
sub comp_entry {
my ($l, $r) = @_;
my @l = $l->rgba;
my @r = $r->rgba;
return $l[0] <=> $r[0]
|| $l[1] <=> $r[1]
|| $l[2] <=> $r[2];
}
|
