]>
Commit | Line | Data |
---|---|---|
faa9b3e7 | 1 | #!perl -w |
66614d6e | 2 | use strict; |
a50608d2 | 3 | use Test::More tests => 127; |
b89b3153 | 4 | use Imager qw(:all); |
4c2d6970 TC |
5 | $^W=1; # warnings during command-line tests |
6 | $|=1; # give us some progress in the test harness | |
e2cb7e23 | 7 | init_log("testout/t106tiff.log",1); |
b89b3153 | 8 | |
66614d6e TC |
9 | my $green=i_color_new(0,255,0,255); |
10 | my $blue=i_color_new(0,0,255,255); | |
11 | my $red=i_color_new(255,0,0,255); | |
b89b3153 | 12 | |
66614d6e | 13 | my $img=Imager::ImgRaw::new(150,150,3); |
b89b3153 TC |
14 | |
15 | i_box_filled($img,70,25,130,125,$green); | |
16 | i_box_filled($img,20,25,80,125,$blue); | |
17 | i_arc($img,75,75,30,0,361,$red); | |
18 | i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]); | |
19 | ||
20 | my $timg = Imager::ImgRaw::new(20, 20, 4); | |
21 | my $trans = i_color_new(255, 0, 0, 127); | |
22 | i_box_filled($timg, 0, 0, 20, 20, $green); | |
23 | i_box_filled($timg, 2, 2, 18, 18, $trans); | |
24 | ||
66614d6e TC |
25 | SKIP: |
26 | { | |
27 | unless (i_has_format("tiff")) { | |
28 | my $im = Imager->new; | |
29 | ok(!$im->read(file=>"testimg/comp4.tif"), "should fail to read tif"); | |
30 | is($im->errstr, "format 'tiff' not supported", "check no tiff message"); | |
31 | $im = Imager->new(xsize=>2, ysize=>2); | |
32 | ok(!$im->write(file=>"testout/notiff.tif"), "should fail to write tiff"); | |
33 | is($im->errstr, 'format not supported', "check no tiff message"); | |
a50608d2 | 34 | skip("no tiff support", 123); |
99616a52 | 35 | } |
66614d6e | 36 | |
faa9b3e7 TC |
37 | Imager::i_tags_add($img, "i_xres", 0, "300", 0); |
38 | Imager::i_tags_add($img, "i_yres", 0, undef, 250); | |
39 | # resolutionunit is centimeters | |
40 | Imager::i_tags_add($img, "tiff_resolutionunit", 0, undef, 3); | |
fd9a31d2 | 41 | Imager::i_tags_add($img, "tiff_software", 0, "t106tiff.t", 0); |
5c829fcf | 42 | open(FH,">testout/t106.tiff") || die "cannot open testout/t106.tiff for writing\n"; |
b89b3153 TC |
43 | binmode(FH); |
44 | my $IO = Imager::io_new_fd(fileno(FH)); | |
66614d6e | 45 | ok(i_writetiff_wiol($img, $IO), "write low level"); |
b89b3153 TC |
46 | close(FH); |
47 | ||
e2cb7e23 | 48 | open(FH,"testout/t106.tiff") or die "cannot open testout/t106.tiff\n"; |
b89b3153 TC |
49 | binmode(FH); |
50 | $IO = Imager::io_new_fd(fileno(FH)); | |
66614d6e TC |
51 | my $cmpimg = i_readtiff_wiol($IO, -1); |
52 | ok($cmpimg, "read low-level"); | |
b89b3153 TC |
53 | |
54 | close(FH); | |
55 | ||
56 | print "# tiff average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n"; | |
b89b3153 | 57 | |
66614d6e | 58 | ok(!i_img_diff($img, $cmpimg), "compare written and read image"); |
4c2d6970 | 59 | |
faa9b3e7 TC |
60 | # check the tags are ok |
61 | my %tags = map { Imager::i_tags_get($cmpimg, $_) } | |
62 | 0 .. Imager::i_tags_count($cmpimg) - 1; | |
66614d6e TC |
63 | ok(abs($tags{i_xres} - 300) < 0.5, "i_xres in range"); |
64 | ok(abs($tags{i_yres} - 250) < 0.5, "i_yres in range"); | |
65 | is($tags{tiff_resolutionunit}, 3, "tiff_resolutionunit"); | |
66 | is($tags{tiff_software}, 't106tiff.t', "tiff_software"); | |
f00e06a0 TC |
67 | is($tags{tiff_photometric}, 2, "tiff_photometric"); # PHOTOMETRIC_RGB is 2 |
68 | is($tags{tiff_bitspersample}, 8, "tiff_bitspersample"); | |
faa9b3e7 | 69 | |
b89b3153 TC |
70 | $IO = Imager::io_new_bufchain(); |
71 | ||
66614d6e | 72 | ok(Imager::i_writetiff_wiol($img, $IO), "write to buffer chain"); |
b89b3153 TC |
73 | my $tiffdata = Imager::io_slurp($IO); |
74 | ||
e2cb7e23 | 75 | open(FH,"testout/t106.tiff"); |
607b851c | 76 | binmode FH; |
b89b3153 TC |
77 | my $odata; |
78 | { local $/; | |
79 | $odata = <FH>; | |
80 | } | |
81 | ||
66614d6e | 82 | is($odata, $tiffdata, "same data in file as in memory"); |
d2dfdcc9 TC |
83 | |
84 | # test Micksa's tiff writer | |
85 | # a shortish fax page | |
86 | my $faximg = Imager::ImgRaw::new(1728, 2000, 1); | |
87 | my $black = i_color_new(0,0,0,255); | |
88 | my $white = i_color_new(255,255,255,255); | |
89 | # vaguely test-patterny | |
90 | i_box_filled($faximg, 0, 0, 1728, 2000, $white); | |
91 | i_box_filled($faximg, 100,100,1628, 200, $black); | |
92 | my $width = 1; | |
93 | my $pos = 100; | |
94 | while ($width+$pos < 1628) { | |
95 | i_box_filled($faximg, $pos, 300, $pos+$width-1, 400, $black); | |
96 | $pos += $width + 20; | |
97 | $width += 2; | |
98 | } | |
99 | open FH, "> testout/t106tiff_fax.tiff" | |
100 | or die "Cannot create testout/t106tiff_fax.tiff: $!"; | |
101 | binmode FH; | |
102 | $IO = Imager::io_new_fd(fileno(FH)); | |
66614d6e | 103 | ok(i_writetiff_wiol_faxable($faximg, $IO, 1), "write faxable, low level"); |
d2dfdcc9 | 104 | close FH; |
4c2d6970 TC |
105 | |
106 | # test the OO interface | |
107 | my $ooim = Imager->new; | |
66614d6e TC |
108 | ok($ooim->read(file=>'testout/t106.tiff'), "read OO"); |
109 | ok($ooim->write(file=>'testout/t106_oo.tiff'), "write OO"); | |
4c2d6970 TC |
110 | |
111 | # OO with the fax image | |
112 | my $oofim = Imager->new; | |
66614d6e TC |
113 | ok($oofim->read(file=>'testout/t106tiff_fax.tiff'), |
114 | "read fax OO"); | |
faa9b3e7 TC |
115 | |
116 | # this should have tags set for the resolution | |
117 | %tags = map @$_, $oofim->tags; | |
66614d6e TC |
118 | is($tags{i_xres}, 204, "fax i_xres"); |
119 | is($tags{i_yres}, 196, "fax i_yres"); | |
120 | ok(!$tags{i_aspect_only}, "i_aspect_only"); | |
faa9b3e7 | 121 | # resunit_inches |
66614d6e | 122 | is($tags{tiff_resolutionunit}, 2, "tiff_resolutionunit"); |
f00e06a0 | 123 | is($tags{tiff_bitspersample}, 1, "tiff_bitspersample"); |
7ebd46b0 | 124 | is($tags{tiff_photometric}, 0, "tiff_photometric"); |
faa9b3e7 | 125 | |
66614d6e TC |
126 | ok($oofim->write(file=>'testout/t106_oo_fax.tiff', class=>'fax'), |
127 | "write OO, faxable"); | |
4c2d6970 TC |
128 | |
129 | # the following should fail since there's no type and no filename | |
130 | my $oodata; | |
66614d6e | 131 | ok(!$ooim->write(data=>\$oodata), "write with no type and no filename to guess with"); |
4c2d6970 TC |
132 | |
133 | # OO to data | |
66614d6e TC |
134 | ok($ooim->write(data=>\$oodata, type=>'tiff'), "write to data") |
135 | or print "# ",$ooim->errstr, "\n"; | |
136 | is($oodata, $tiffdata, "check data matches between memory and file"); | |
4c2d6970 TC |
137 | |
138 | # make sure we can write non-fine mode | |
66614d6e | 139 | ok($oofim->write(file=>'testout/t106_oo_faxlo.tiff', class=>'fax', fax_fine=>0), "write OO, fax standard mode"); |
5bb828f1 TC |
140 | |
141 | # paletted reads | |
142 | my $img4 = Imager->new; | |
5bb828f1 | 143 | ok($img4->read(file=>'testimg/comp4.tif'), "reading 4-bit paletted"); |
5386861e | 144 | is($img4->type, 'paletted', "image isn't paletted"); |
5bb828f1 | 145 | print "# colors: ", $img4->colorcount,"\n"; |
5386861e | 146 | cmp_ok($img4->colorcount, '<=', 16, "more than 16 colors!"); |
5bb828f1 TC |
147 | #ok($img4->write(file=>'testout/t106_was4.ppm'), |
148 | # "Cannot write img4"); | |
149 | # I know I'm using BMP before it's test, but comp4.tif started life | |
150 | # as comp4.bmp | |
151 | my $bmp4 = Imager->new; | |
152 | ok($bmp4->read(file=>'testimg/comp4.bmp'), "reading 4-bit bmp!"); | |
66614d6e | 153 | my $diff = i_img_diff($img4->{IMG}, $bmp4->{IMG}); |
5bb828f1 TC |
154 | print "# diff $diff\n"; |
155 | ok($diff == 0, "image mismatch"); | |
156 | my $img8 = Imager->new; | |
157 | ok($img8->read(file=>'testimg/comp8.tif'), "reading 8-bit paletted"); | |
5386861e | 158 | is($img8->type, 'paletted', "image isn't paletted"); |
5bb828f1 TC |
159 | print "# colors: ", $img8->colorcount,"\n"; |
160 | #ok($img8->write(file=>'testout/t106_was8.ppm'), | |
161 | # "Cannot write img8"); | |
162 | ok($img8->colorcount == 256, "more colors than expected"); | |
163 | my $bmp8 = Imager->new; | |
164 | ok($bmp8->read(file=>'testimg/comp8.bmp'), "reading 8-bit bmp!"); | |
165 | $diff = i_img_diff($img8->{IMG}, $bmp8->{IMG}); | |
166 | print "# diff $diff\n"; | |
167 | ok($diff == 0, "image mismatch"); | |
168 | my $bad = Imager->new; | |
169 | ok($bad->read(file=>'testimg/comp4bad.tif'), "bad image not returned"); | |
170 | ok(scalar $bad->tags(name=>'i_incomplete'), "incomplete tag not set"); | |
f62b2d84 | 171 | ok($img8->write(file=>'testout/t106_pal8.tif'), "writing 8-bit paletted"); |
230e675b TC |
172 | my $cmp8 = Imager->new; |
173 | ok($cmp8->read(file=>'testout/t106_pal8.tif'), | |
f62b2d84 | 174 | "reading 8-bit paletted"); |
230e675b | 175 | #print "# ",$cmp8->errstr,"\n"; |
5386861e TC |
176 | is($cmp8->type, 'paletted', "pal8 isn't paletted"); |
177 | is($cmp8->colorcount, 256, "pal8 bad colorcount"); | |
f62b2d84 TC |
178 | $diff = i_img_diff($img8->{IMG}, $cmp8->{IMG}); |
179 | print "# diff $diff\n"; | |
180 | ok($diff == 0, "written image doesn't match read"); | |
181 | ok($img4->write(file=>'testout/t106_pal4.tif'), "writing 4-bit paletted"); | |
182 | ok(my $cmp4 = Imager->new->read(file=>'testout/t106_pal4.tif'), | |
183 | "reading 4-bit paletted"); | |
5386861e TC |
184 | is($cmp4->type, 'paletted', "pal4 isn't paletted"); |
185 | is($cmp4->colorcount, 16, "pal4 bad colorcount"); | |
f62b2d84 TC |
186 | $diff = i_img_diff($img4->{IMG}, $cmp4->{IMG}); |
187 | print "# diff $diff\n"; | |
188 | ok($diff == 0, "written image doesn't match read"); | |
10461f9a TC |
189 | |
190 | my $work; | |
191 | my $seekpos; | |
192 | sub io_writer { | |
193 | my ($what) = @_; | |
194 | if ($seekpos > length $work) { | |
195 | $work .= "\0" x ($seekpos - length $work); | |
196 | } | |
197 | substr($work, $seekpos, length $what) = $what; | |
198 | $seekpos += length $what; | |
199 | ||
200 | 1; | |
201 | } | |
202 | sub io_reader { | |
203 | my ($size, $maxread) = @_; | |
204 | #print "io_reader($size, $maxread) pos $seekpos\n"; | |
205 | my $out = substr($work, $seekpos, $maxread); | |
206 | $seekpos += length $out; | |
207 | $out; | |
208 | } | |
209 | sub io_reader2 { | |
210 | my ($size, $maxread) = @_; | |
211 | #print "io_reader2($size, $maxread) pos $seekpos\n"; | |
212 | my $out = substr($work, $seekpos, $size); | |
213 | $seekpos += length $out; | |
214 | $out; | |
215 | } | |
216 | use IO::Seekable; | |
217 | sub io_seeker { | |
218 | my ($offset, $whence) = @_; | |
219 | #print "io_seeker($offset, $whence)\n"; | |
220 | if ($whence == SEEK_SET) { | |
221 | $seekpos = $offset; | |
222 | } | |
223 | elsif ($whence == SEEK_CUR) { | |
224 | $seekpos += $offset; | |
225 | } | |
226 | else { # SEEK_END | |
227 | $seekpos = length($work) + $offset; | |
228 | } | |
229 | #print "-> $seekpos\n"; | |
230 | $seekpos; | |
231 | } | |
232 | my $did_close; | |
233 | sub io_closer { | |
234 | ++$did_close; | |
235 | } | |
236 | ||
237 | # read via cb | |
238 | $work = $tiffdata; | |
239 | $seekpos = 0; | |
240 | my $IO2 = Imager::io_new_cb(undef, \&io_reader, \&io_seeker, undef); | |
241 | ok($IO2, "new readcb obj"); | |
242 | my $img5 = i_readtiff_wiol($IO2, -1); | |
243 | ok($img5, "read via cb"); | |
244 | ok(i_img_diff($img5, $img) == 0, "read from cb diff"); | |
245 | ||
246 | # read via cb2 | |
247 | $work = $tiffdata; | |
248 | $seekpos = 0; | |
249 | my $IO3 = Imager::io_new_cb(undef, \&io_reader2, \&io_seeker, undef); | |
250 | ok($IO3, "new readcb2 obj"); | |
251 | my $img6 = i_readtiff_wiol($IO3, -1); | |
252 | ok($img6, "read via cb2"); | |
253 | ok(i_img_diff($img6, $img) == 0, "read from cb2 diff"); | |
254 | ||
255 | # write via cb | |
256 | $work = ''; | |
257 | $seekpos = 0; | |
258 | my $IO4 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker, | |
259 | \&io_closer); | |
260 | ok($IO4, "new writecb obj"); | |
261 | ok(i_writetiff_wiol($img, $IO4), "write to cb"); | |
5386861e | 262 | is($work, $odata, "write cb match"); |
10461f9a | 263 | ok($did_close, "write cb did close"); |
332033c5 | 264 | open D1, ">testout/d1.tiff" or die; |
10461f9a TC |
265 | print D1 $work; |
266 | close D1; | |
332033c5 | 267 | open D2, ">testout/d2.tiff" or die; |
10461f9a TC |
268 | print D2 $tiffdata; |
269 | close D2; | |
270 | ||
271 | # write via cb2 | |
272 | $work = ''; | |
273 | $seekpos = 0; | |
274 | $did_close = 0; | |
275 | my $IO5 = Imager::io_new_cb(\&io_writer, \&io_reader, \&io_seeker, | |
276 | \&io_closer, 1); | |
277 | ok($IO5, "new writecb obj 2"); | |
278 | ok(i_writetiff_wiol($img, $IO5), "write to cb2"); | |
5386861e | 279 | is($work, $odata, "write cb2 match"); |
10461f9a TC |
280 | ok($did_close, "write cb2 did close"); |
281 | ||
332033c5 | 282 | open D3, ">testout/d3.tiff" or die; |
10461f9a TC |
283 | print D3 $work; |
284 | close D3; | |
285 | ||
286 | # multi-image write/read | |
287 | my @imgs; | |
288 | push(@imgs, map $ooim->copy(), 1..3); | |
289 | for my $i (0..$#imgs) { | |
290 | $imgs[$i]->addtag(name=>"tiff_pagename", value=>"Page ".($i+1)); | |
291 | } | |
292 | my $rc = Imager->write_multi({file=>'testout/t106_multi.tif'}, @imgs); | |
293 | ok($rc, "writing multiple images to tiff"); | |
294 | my @out = Imager->read_multi(file=>'testout/t106_multi.tif'); | |
295 | ok(@out == @imgs, "reading multiple images from tiff"); | |
296 | @out == @imgs or print "# ",scalar @out, " ",Imager->errstr,"\n"; | |
297 | for my $i (0..$#imgs) { | |
298 | ok(i_img_diff($imgs[$i]{IMG}, $out[$i]{IMG}) == 0, | |
299 | "comparing image $i"); | |
300 | my ($tag) = $out[$i]->tags(name=>'tiff_pagename'); | |
5386861e | 301 | is($tag, "Page ".($i+1), |
10461f9a TC |
302 | "tag doesn't match original image"); |
303 | } | |
304 | ||
be371490 TC |
305 | # writing even more images to tiff - we weren't handling more than five |
306 | # correctly on read | |
307 | @imgs = map $ooim->copy(), 1..40; | |
0cb68c19 | 308 | $rc = Imager->write_multi({file=>'testout/t106_multi2.tif'}, @imgs); |
be371490 TC |
309 | ok($rc, "writing 40 images to tiff"); |
310 | @out = Imager->read_multi(file=>'testout/t106_multi2.tif'); | |
311 | ok(@imgs == @out, "reading 40 images from tiff"); | |
312 | # force some allocation activity - helps crash here if it's the problem | |
313 | @out = @imgs = (); | |
314 | ||
10461f9a TC |
315 | # multi-image fax files |
316 | ok(Imager->write_multi({file=>'testout/t106_faxmulti.tiff', class=>'fax'}, | |
317 | $oofim, $oofim), "write multi fax image"); | |
318 | @imgs = Imager->read_multi(file=>'testout/t106_faxmulti.tiff'); | |
319 | ok(@imgs == 2, "reading multipage fax"); | |
320 | ok(Imager::i_img_diff($imgs[0]{IMG}, $oofim->{IMG}) == 0, | |
321 | "compare first fax image"); | |
322 | ok(Imager::i_img_diff($imgs[1]{IMG}, $oofim->{IMG}) == 0, | |
323 | "compare second fax image"); | |
8c3af7b3 TC |
324 | |
325 | my ($format) = $imgs[0]->tags(name=>'i_format'); | |
5386861e | 326 | is($format, 'tiff', "check i_format tag"); |
ffeb4a67 | 327 | |
3cff89e2 TC |
328 | my $unit = $imgs[0]->tags(name=>'tiff_resolutionunit'); |
329 | ok(defined $unit && $unit == 2, "check tiff_resolutionunit tag"); | |
330 | my $unitname = $imgs[0]->tags(name=>'tiff_resolutionunit_name'); | |
5386861e | 331 | is($unitname, 'inch', "check tiff_resolutionunit_name tag"); |
3cff89e2 | 332 | |
ffeb4a67 TC |
333 | my $warned = Imager->new; |
334 | ok($warned->read(file=>"testimg/tiffwarn.tif"), "read tiffwarn.tif"); | |
335 | my ($warning) = $warned->tags(name=>'i_warning'); | |
336 | ok(defined $warning && $warning =~ /unknown field with tag 28712/, | |
337 | "check that warning tag set and correct"); | |
8f8bd9aa TC |
338 | |
339 | { # support for reading a given page | |
340 | # first build a simple test image | |
341 | my $im1 = Imager->new(xsize=>50, ysize=>50); | |
342 | $im1->box(filled=>1, color=>$blue); | |
343 | $im1->addtag(name=>'tiff_pagename', value => "Page One"); | |
344 | my $im2 = Imager->new(xsize=>60, ysize=>60); | |
345 | $im2->box(filled=>1, color=>$green); | |
346 | $im2->addtag(name=>'tiff_pagename', value=>"Page Two"); | |
347 | ||
348 | # read second page | |
349 | my $page_file = 'testout/t106_pages.tif'; | |
350 | ok(Imager->write_multi({ file=> $page_file}, $im1, $im2), | |
351 | "build simple multiimage for page tests"); | |
352 | my $imwork = Imager->new; | |
353 | ok($imwork->read(file=>$page_file, page=>1), | |
354 | "read second page"); | |
355 | is($im2->getwidth, $imwork->getwidth, "check width"); | |
356 | is($im2->getwidth, $imwork->getheight, "check height"); | |
357 | is(i_img_diff($imwork->{IMG}, $im2->{IMG}), 0, | |
358 | "check image content"); | |
359 | my ($page_name) = $imwork->tags(name=>'tiff_pagename'); | |
360 | is($page_name, 'Page Two', "check tag we set"); | |
361 | ||
362 | # try an out of range page | |
363 | ok(!$imwork->read(file=>$page_file, page=>2), | |
364 | "check out of range page"); | |
365 | is($imwork->errstr, "could not switch to page 2", "check message"); | |
366 | } | |
2691d220 TC |
367 | |
368 | { # test writing returns an error message correctly | |
369 | # open a file read only and try to write to it | |
370 | open TIFF, "> testout/t106_empty.tif" or die; | |
371 | close TIFF; | |
372 | open TIFF, "< testout/t106_empty.tif" | |
373 | or skip "Cannot open testout/t106_empty.tif for reading", 8; | |
374 | binmode TIFF; | |
375 | my $im = Imager->new(xsize=>100, ysize=>100); | |
376 | ok(!$im->write(fh => \*TIFF, type=>'tiff'), | |
377 | "fail to write to read only handle"); | |
378 | cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)', | |
379 | "check error message"); | |
380 | ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF }, $im), | |
381 | "fail to write multi to read only handle"); | |
382 | cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)', | |
383 | "check error message"); | |
384 | ok(!$im->write(fh => \*TIFF, type=>'tiff', class=>'fax'), | |
385 | "fail to write to read only handle (fax)"); | |
386 | cmp_ok($im->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)', | |
387 | "check error message"); | |
388 | ok(!Imager->write_multi({ type => 'tiff', fh => \*TIFF, class=>'fax' }, $im), | |
389 | "fail to write multi to read only handle (fax)"); | |
390 | cmp_ok(Imager->errstr, '=~', 'Could not create TIFF object: Error writing TIFF header: write\(\)', | |
391 | "check error message"); | |
392 | } | |
393 | ||
394 | { # test reading returns an error correctly - use test script as an | |
395 | # invalid TIFF file | |
396 | my $im = Imager->new; | |
397 | ok(!$im->read(file=>'t/t106tiff.t', type=>'tiff'), | |
398 | "fail to read script as image"); | |
f364e883 TC |
399 | # we get different magic number values depending on the platform |
400 | # byte ordering | |
401 | cmp_ok($im->errstr, '=~', | |
91add018 | 402 | "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", |
f364e883 | 403 | "check error message"); |
2691d220 TC |
404 | my @ims = Imager->read_multi(file =>'t/t106tiff.t', type=>'tiff'); |
405 | ok(!@ims, "fail to read_multi script as image"); | |
f364e883 | 406 | cmp_ok($im->errstr, '=~', |
91add018 | 407 | "Error opening file: Not a TIFF (?:or MDI )?file, bad magic number (8483 \\(0x2123\\)|8993 \\(0x2321\\))", |
2691d220 TC |
408 | "check error message"); |
409 | } | |
2b405c9e TC |
410 | |
411 | { # write_multi to data | |
412 | my $data; | |
413 | my $im = Imager->new(xsize => 50, ysize => 50); | |
414 | ok(Imager->write_multi({ data => \$data, type=>'tiff' }, $im, $im), | |
415 | "write multi to in memory"); | |
416 | ok(length $data, "make sure something written"); | |
417 | my @im = Imager->read_multi(data => $data); | |
418 | is(@im, 2, "make sure we can read it back"); | |
419 | is(Imager::i_img_diff($im[0]{IMG}, $im->{IMG}), 0, | |
420 | "check first image"); | |
421 | is(Imager::i_img_diff($im[1]{IMG}, $im->{IMG}), 0, | |
422 | "check second image"); | |
423 | } | |
a50608d2 TC |
424 | |
425 | { # handling of an alpha channel for various images | |
426 | my $photo_rgb = 2; | |
427 | my $photo_cmyk = 5; | |
428 | my $photo_cielab = 8; | |
429 | my @alpha_images = | |
430 | ( | |
431 | [ 'srgb.tif', 3, $photo_rgb ], | |
432 | [ 'srgba.tif', 4, $photo_rgb ], | |
433 | [ 'srgbaa.tif', 4, $photo_rgb ], | |
434 | [ 'scmyk.tif', 3, $photo_cmyk ], | |
435 | [ 'scmyka.tif', 4, $photo_cmyk ], | |
436 | [ 'scmykaa.tif', 4, $photo_cmyk ], | |
437 | [ 'slab.tif', 3, $photo_cielab ], | |
438 | ); | |
439 | for my $test (@alpha_images) { | |
440 | my $im = Imager->new; | |
441 | ok($im->read(file => "testimg/$test->[0]"), | |
8a41a626 TC |
442 | "read alpha test $test->[0]") |
443 | or print "# ", $im->errstr, "\n"; | |
a50608d2 TC |
444 | is($im->getchannels, $test->[1], "channels for $test->[0] match"); |
445 | is($im->tags(name=>'tiff_photometric'), $test->[2], | |
446 | "photometric for $test->[0] match"); | |
447 | } | |
448 | } | |
b89b3153 | 449 | } |
2b405c9e | 450 |