]>
Commit | Line | Data |
---|---|---|
faa9b3e7 | 1 | #!perl -w |
faa9b3e7 | 2 | use strict; |
6d5c85a2 | 3 | use Test::More tests => 53; |
0bfa6bd6 | 4 | use Imager qw(:all); |
6d5c85a2 | 5 | use Imager::Test qw/is_color3 is_color4 test_image test_image_mono/; |
40e78f96 TC |
6 | |
7 | -d "testout" or mkdir "testout"; | |
8 | ||
cc59eadc | 9 | Imager->open_log(log => "testout/t103raw.log"); |
9267f8f3 | 10 | |
500888da TC |
11 | $| = 1; |
12 | ||
faa9b3e7 TC |
13 | my $green=i_color_new(0,255,0,255); |
14 | my $blue=i_color_new(0,0,255,255); | |
15 | my $red=i_color_new(255,0,0,255); | |
9267f8f3 | 16 | |
faa9b3e7 TC |
17 | my $img=Imager::ImgRaw::new(150,150,3); |
18 | my $cmpimg=Imager::ImgRaw::new(150,150,3); | |
9267f8f3 TC |
19 | |
20 | i_box_filled($img,70,25,130,125,$green); | |
21 | i_box_filled($img,20,25,80,125,$blue); | |
22 | i_arc($img,75,75,30,0,361,$red); | |
23 | i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]); | |
24 | ||
25 | my $timg = Imager::ImgRaw::new(20, 20, 4); | |
26 | my $trans = i_color_new(255, 0, 0, 127); | |
27 | i_box_filled($timg, 0, 0, 20, 20, $green); | |
28 | i_box_filled($timg, 2, 2, 18, 18, $trans); | |
29 | ||
30 | open(FH,">testout/t103.raw") || die "Cannot open testout/t103.raw for writing\n"; | |
31 | binmode(FH); | |
faa9b3e7 | 32 | my $IO = Imager::io_new_fd( fileno(FH) ); |
0bfa6bd6 TC |
33 | ok(i_writeraw_wiol($img, $IO), "write raw low") or |
34 | print "# Cannot write testout/t103.raw\n"; | |
9267f8f3 TC |
35 | close(FH); |
36 | ||
9267f8f3 TC |
37 | open(FH,"testout/t103.raw") || die "Cannot open testout/t103.raw\n"; |
38 | binmode(FH); | |
895dbd34 | 39 | $IO = Imager::io_new_fd( fileno(FH) ); |
0bfa6bd6 TC |
40 | $cmpimg = i_readraw_wiol($IO, 150, 150, 3, 3, 0); |
41 | ok($cmpimg, "read raw low") | |
42 | or print "# Cannot read testout/t103.raw\n"; | |
9267f8f3 TC |
43 | close(FH); |
44 | ||
45 | print "# raw average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n"; | |
9267f8f3 TC |
46 | |
47 | # I could have kept the raw images for these tests in binary files in | |
48 | # testimg/, but I think keeping them as hex encoded data in here makes | |
49 | # it simpler to add more if necessary | |
50 | # Later we may change this to read from a scalar instead | |
51 | save_data('testout/t103_base.raw'); | |
52 | save_data('testout/t103_3to4.raw'); | |
53 | save_data('testout/t103_line_int.raw'); | |
54 | save_data('testout/t103_img_int.raw'); | |
55 | ||
56 | # load the base image | |
57 | open FH, "testout/t103_base.raw" | |
58 | or die "Cannot open testout/t103_base.raw: $!"; | |
59 | binmode FH; | |
895dbd34 AMH |
60 | $IO = Imager::io_new_fd( fileno(FH) ); |
61 | ||
0bfa6bd6 TC |
62 | my $baseimg = i_readraw_wiol( $IO, 4, 4, 3, 3, 0); |
63 | ok($baseimg, "read base raw image") | |
9267f8f3 TC |
64 | or die "Cannot read base raw image"; |
65 | close FH; | |
66 | ||
67 | # the actual read tests | |
68 | # each read_test() call does 2 tests: | |
69 | # - check if the read succeeds | |
70 | # - check if it matches $baseimg | |
0bfa6bd6 TC |
71 | read_test('testout/t103_3to4.raw', 4, 4, 4, 3, 0, $baseimg); |
72 | read_test('testout/t103_line_int.raw', 4, 4, 3, 3, 1, $baseimg); | |
9267f8f3 TC |
73 | # intrl==2 is documented in raw.c but doesn't seem to be implemented |
74 | #read_test('testout/t103_img_int.raw', 4, 4, 3, 3, 2, $baseimg, 7); | |
75 | ||
faa9b3e7 | 76 | # paletted images |
0bfa6bd6 TC |
77 | SKIP: |
78 | { | |
79 | my $palim = Imager::i_img_pal_new(20, 20, 3, 256); | |
80 | ok($palim, "make paletted image") | |
81 | or skip("couldn't make paletted image", 2); | |
82 | my $redindex = Imager::i_addcolors($palim, $red); | |
83 | my $blueindex = Imager::i_addcolors($palim, $blue); | |
84 | for my $y (0..9) { | |
85 | Imager::i_ppal($palim, 0, $y, ($redindex) x 20); | |
86 | } | |
87 | for my $y (10..19) { | |
88 | Imager::i_ppal($palim, 0, $y, ($blueindex) x 20); | |
89 | } | |
90 | open FH, "> testout/t103_pal.raw" | |
91 | or die "Cannot create testout/t103_pal.raw: $!"; | |
92 | binmode FH; | |
93 | $IO = Imager::io_new_fd(fileno(FH)); | |
94 | ok(i_writeraw_wiol($palim, $IO), "write low paletted"); | |
95 | close FH; | |
96 | ||
97 | open FH, "testout/t103_pal.raw" | |
98 | or die "Cannot open testout/t103_pal.raw: $!"; | |
99 | binmode FH; | |
100 | my $data = do { local $/; <FH> }; | |
101 | is($data, "\x0" x 200 . "\x1" x 200, "compare paletted data written"); | |
102 | close FH; | |
faa9b3e7 | 103 | } |
faa9b3e7 TC |
104 | |
105 | # 16-bit image | |
106 | # we don't have 16-bit reads yet | |
0bfa6bd6 TC |
107 | SKIP: |
108 | { | |
109 | my $img16 = Imager::i_img_16_new(150, 150, 3); | |
110 | ok($img16, "make 16-bit/sample image") | |
111 | or skip("couldn't make 16 bit/sample image", 1); | |
112 | i_box_filled($img16,70,25,130,125,$green); | |
113 | i_box_filled($img16,20,25,80,125,$blue); | |
114 | i_arc($img16,75,75,30,0,361,$red); | |
115 | i_conv($img16,[0.1, 0.2, 0.4, 0.2, 0.1]); | |
116 | ||
117 | open FH, "> testout/t103_16.raw" | |
118 | or die "Cannot create testout/t103_16.raw: $!"; | |
119 | binmode FH; | |
120 | $IO = Imager::io_new_fd(fileno(FH)); | |
121 | ok(i_writeraw_wiol($img16, $IO), "write low 16 bit image"); | |
122 | close FH; | |
123 | } | |
faa9b3e7 TC |
124 | |
125 | # try a simple virtual image | |
0bfa6bd6 TC |
126 | SKIP: |
127 | { | |
128 | my $maskimg = Imager::i_img_masked_new($img, undef, 0, 0, 150, 150); | |
129 | ok($maskimg, "make masked image") | |
130 | or skip("couldn't make masked image", 3); | |
131 | ||
132 | open FH, "> testout/t103_virt.raw" | |
133 | or die "Cannot create testout/t103_virt.raw: $!"; | |
134 | binmode FH; | |
135 | $IO = Imager::io_new_fd(fileno(FH)); | |
136 | ok(i_writeraw_wiol($maskimg, $IO), "write virtual raw"); | |
137 | close FH; | |
faa9b3e7 | 138 | |
0bfa6bd6 TC |
139 | open FH, "testout/t103_virt.raw" |
140 | or die "Cannot open testout/t103_virt.raw: $!"; | |
141 | binmode FH; | |
142 | $IO = Imager::io_new_fd(fileno(FH)); | |
143 | my $cmpimgmask = i_readraw_wiol($IO, 150, 150, 3, 3, 0); | |
144 | ok($cmpimgmask, "read result of masked write"); | |
145 | my $diff = i_img_diff($maskimg, $cmpimgmask); | |
146 | print "# difference for virtual image $diff\n"; | |
147 | is($diff, 0, "compare masked to read"); | |
148 | ||
149 | # check that i_format is set correctly | |
150 | my $index = Imager::i_tags_find($cmpimgmask, 'i_format', 0); | |
151 | if ($index) { | |
152 | my $value = Imager::i_tags_get($cmpimgmask, $index); | |
153 | is($value, 'raw', "check i_format value"); | |
154 | } | |
155 | else { | |
156 | fail("couldn't find i_format tag"); | |
157 | } | |
50dc291e TC |
158 | } |
159 | ||
5f8f8e17 TC |
160 | { # error handling checks |
161 | # should get an error writing to a open for read file | |
162 | # make a empty file | |
163 | open RAW, "> testout/t103_empty.raw" | |
164 | or die "Cannot create testout/t103_empty.raw: $!"; | |
165 | close RAW; | |
166 | open RAW, "< testout/t103_empty.raw" | |
167 | or die "Cannot open testout/t103_empty.raw: $!"; | |
168 | my $im = Imager->new(xsize => 50, ysize=>50); | |
6d5c85a2 | 169 | ok(!$im->write(fh => \*RAW, type => 'raw', buffered => 0), |
5f8f8e17 TC |
170 | "write to open for read handle"); |
171 | cmp_ok($im->errstr, '=~', '^Could not write to file: write\(\) failure', | |
172 | "check error message"); | |
173 | close RAW; | |
174 | ||
175 | # should get an error reading an empty file | |
500888da | 176 | ok(!$im->read(file => 'testout/t103_empty.raw', xsize => 50, ysize=>50, type=>'raw', interleave => 1), |
5f8f8e17 TC |
177 | 'read an empty file'); |
178 | is($im->errstr, 'premature end of file', "check message"); | |
1ed8d269 TC |
179 | SKIP: |
180 | { | |
181 | # see 862083f7e40bc2a9e3b94aedce56c1336e7bdb25 in perl5 git | |
182 | $] >= 5.010 | |
183 | or skip "5.8.x and earlier don't treat a read on a WRONLY file as an error", 2; | |
184 | open RAW, "> testout/t103_empty.raw" | |
185 | or die "Cannot create testout/t103_empty.raw: $!"; | |
186 | ok(!$im->read(fh => \*RAW, , xsize => 50, ysize=>50, type=>'raw', interleave => 1), | |
187 | 'read a file open for write'); | |
188 | cmp_ok($im->errstr, '=~', '^error reading file: read\(\) failure', "check message"); | |
189 | } | |
5f8f8e17 TC |
190 | } |
191 | ||
f245645a TC |
192 | |
193 | { | |
194 | ok(grep($_ eq 'raw', Imager->read_types), "check raw in read types"); | |
195 | ok(grep($_ eq 'raw', Imager->write_types), "check raw in write types"); | |
196 | } | |
197 | ||
500888da TC |
198 | |
199 | { # OO no interleave warning | |
200 | my $im = Imager->new; | |
201 | my $msg; | |
202 | local $SIG{__WARN__} = sub { $msg = "@_" }; | |
203 | ok($im->read(file => "testout/t103_line_int.raw", xsize => 4, ysize => 4, | |
204 | type => "raw"), | |
205 | "read without interleave parameter") | |
206 | or print "# ", $im->errstr, "\n"; | |
207 | ok($msg, "should have warned"); | |
208 | like($msg, qr/interleave/, "check warning is ok"); | |
209 | # check we got the right value | |
210 | is_color3($im->getpixel(x => 0, y => 0), 0x00, 0x11, 0x22, | |
211 | "check the image was read correctly"); | |
212 | ||
213 | # check no warning if either is supplied | |
214 | $im = Imager->new; | |
215 | undef $msg; | |
216 | ok($im->read(file => "testout/t103_base.raw", xsize => 4, ysize => 4, type => "raw", interleave => 0), | |
217 | "read with interleave 0"); | |
218 | is($msg, undef, "no warning"); | |
219 | is_color3($im->getpixel(x => 0, y => 0), 0x00, 0x11, 0x22, | |
220 | "check read non-interleave"); | |
221 | ||
222 | $im = Imager->new; | |
223 | undef $msg; | |
224 | ok($im->read(file => "testout/t103_base.raw", xsize => 4, ysize => 4, type => "raw", raw_interleave => 0), | |
225 | "read with raw_interleave 0"); | |
226 | is($msg, undef, "no warning"); | |
227 | is_color3($im->getpixel(x => 1, y => 0), 0x01, 0x12, 0x23, | |
228 | "check read non-interleave"); | |
229 | ||
230 | # make sure set to 1 is sane | |
231 | $im = Imager->new; | |
232 | undef $msg; | |
233 | ok($im->read(file => "testout/t103_line_int.raw", xsize => 4, ysize => 4, type => "raw", raw_interleave => 1), | |
234 | "read with raw_interleave 1"); | |
235 | is($msg, undef, "no warning"); | |
236 | is_color3($im->getpixel(x => 2, y => 0), 0x02, 0x13, 0x24, | |
237 | "check read interleave = 1"); | |
238 | } | |
239 | ||
240 | { # invalid interleave error handling | |
241 | my $im = Imager->new; | |
242 | ok(!$im->read(file => "testout/t103_base.raw", raw_interleave => 2, type => "raw", xsize => 4, ysize => 4), | |
243 | "invalid interleave"); | |
244 | is($im->errstr, "raw_interleave must be 0 or 1", "check message"); | |
245 | } | |
246 | ||
247 | { # store/data channel behaviour | |
248 | my $im = Imager->new; | |
249 | ok($im->read(file => "testout/t103_3to4.raw", xsize => 4, ysize => 4, | |
250 | raw_datachannels => 4, raw_interleave => 0, type => "raw"), | |
251 | "read 4 channel file as 3 channels") | |
252 | or print "# ", $im->errstr, "\n"; | |
253 | is_color3($im->getpixel(x => 2, y => 1), 0x12, 0x23, 0x34, | |
254 | "check read correctly"); | |
255 | } | |
256 | ||
257 | { # should fail to read with storechannels > 4 | |
258 | my $im = Imager->new; | |
259 | ok(!$im->read(file => "testout/t103_line_int.raw", type => "raw", | |
260 | raw_interleave => 1, xsize => 4, ysize => 4, | |
261 | raw_storechannels => 5), | |
262 | "read with large storechannels"); | |
263 | is($im->errstr, "raw_storechannels must be between 1 and 4", | |
264 | "check error message"); | |
265 | } | |
266 | ||
267 | { # should zero spare channels if storechannels > datachannels | |
268 | my $im = Imager->new; | |
269 | ok($im->read(file => "testout/t103_base.raw", type => "raw", | |
270 | raw_interleave => 0, xsize => 4, ysize => 4, | |
271 | raw_storechannels => 4), | |
272 | "read with storechannels > datachannels"); | |
273 | is($im->getchannels, 4, "should have 4 channels"); | |
274 | is_color4($im->getpixel(x => 2, y => 1), 0x12, 0x23, 0x34, 0x00, | |
275 | "check last channel zeroed"); | |
276 | } | |
277 | ||
6d5c85a2 TC |
278 | { |
279 | my @ims = ( basic => test_image(), mono => test_image_mono() ); | |
280 | push @ims, masked => test_image()->masked(); | |
281 | ||
282 | my $fail_close = sub { | |
283 | Imager::i_push_error(0, "synthetic close failure"); | |
284 | return 0; | |
285 | }; | |
286 | ||
287 | while (my ($type, $im) = splice(@ims, 0, 2)) { | |
288 | my $io = Imager::io_new_cb(sub { 1 }, undef, undef, $fail_close); | |
289 | ok(!$im->write(io => $io, type => "raw"), | |
290 | "write $type image with a failing close handler"); | |
291 | like($im->errstr, qr/synthetic close failure/, | |
292 | "check error message"); | |
293 | } | |
294 | } | |
295 | ||
cc59eadc TC |
296 | Imager->close_log; |
297 | ||
298 | unless ($ENV{IMAGER_KEEP_FILES}) { | |
299 | unlink "testout/t103raw.log"; | |
300 | unlink(qw(testout/t103_base.raw testout/t103_3to4.raw | |
301 | testout/t103_line_int.raw testout/t103_img_int.raw)) | |
302 | } | |
500888da | 303 | |
9267f8f3 | 304 | sub read_test { |
0bfa6bd6 | 305 | my ($in, $xsize, $ysize, $data, $store, $intrl, $base) = @_; |
9267f8f3 TC |
306 | open FH, $in or die "Cannot open $in: $!"; |
307 | binmode FH; | |
895dbd34 AMH |
308 | my $IO = Imager::io_new_fd( fileno(FH) ); |
309 | ||
310 | my $img = i_readraw_wiol($IO, $xsize, $ysize, $data, $store, $intrl); | |
0bfa6bd6 TC |
311 | SKIP: |
312 | { | |
313 | ok($img, "read_test $in read") | |
314 | or skip("couldn't read $in", 1); | |
315 | is(i_img_diff($img, $baseimg), 0, "read_test $in compare"); | |
9267f8f3 TC |
316 | } |
317 | } | |
318 | ||
319 | sub save_data { | |
320 | my $outname = shift; | |
321 | my $data = load_data(); | |
322 | open FH, "> $outname" or die "Cannot create $outname: $!"; | |
323 | binmode FH; | |
324 | print FH $data; | |
325 | close FH; | |
326 | } | |
327 | ||
328 | sub load_data { | |
329 | my $hex = ''; | |
330 | while (<DATA>) { | |
331 | next if /^#/; | |
332 | last if /^EOF/; | |
333 | chomp; | |
334 | $hex .= $_; | |
335 | } | |
336 | $hex =~ tr/ //d; | |
337 | my $result = pack("H*", $hex); | |
faa9b3e7 | 338 | #print unpack("H*", $result),"\n"; |
9267f8f3 TC |
339 | return $result; |
340 | } | |
341 | ||
9267f8f3 TC |
342 | # FIXME: may need tests for 1,2,4 channel images |
343 | ||
344 | __DATA__ | |
345 | # we keep some packed raw images here | |
346 | # we decode this in the code, ignoring lines starting with #, a subfile | |
347 | # ends with EOF, data is HEX encoded (spaces ignored) | |
348 | ||
349 | # basic 3 channel version of the image | |
350 | 001122 011223 021324 031425 | |
351 | 102132 112233 122334 132435 | |
352 | 203142 213243 223344 233445 | |
353 | 304152 314253 324354 334455 | |
354 | EOF | |
355 | ||
356 | # test image for reading a 4 channel image into a 3 channel image | |
357 | # 4 x 4 pixels | |
358 | 00112233 01122334 02132435 03142536 | |
359 | 10213243 11223344 12233445 13243546 | |
360 | 20314253 21324354 22334455 23344556 | |
361 | 30415263 31425364 32435465 33445566 | |
362 | EOF | |
363 | ||
364 | # test image for line based interlacing | |
365 | # 4 x 4 pixels | |
366 | # first line | |
367 | 00 01 02 03 | |
368 | 11 12 13 14 | |
369 | 22 23 24 25 | |
370 | ||
371 | # second line | |
372 | 10 11 12 13 | |
373 | 21 22 23 24 | |
374 | 32 33 34 35 | |
375 | ||
376 | # third line | |
377 | 20 21 22 23 | |
378 | 31 32 33 34 | |
379 | 42 43 44 45 | |
380 | ||
381 | # fourth line | |
382 | 30 31 32 33 | |
383 | 41 42 43 44 | |
384 | 52 53 54 55 | |
385 | ||
386 | EOF | |
387 | ||
388 | # test image for image based interlacing | |
389 | # first channel | |
390 | 00 01 02 03 | |
391 | 10 11 12 13 | |
392 | 20 21 22 23 | |
393 | 30 31 32 33 | |
394 | ||
395 | # second channel | |
396 | 11 12 13 14 | |
397 | 21 22 23 24 | |
398 | 31 32 33 34 | |
399 | 41 42 43 44 | |
400 | ||
401 | # third channel | |
402 | 22 23 24 25 | |
403 | 32 33 34 35 | |
404 | 42 43 44 45 | |
405 | 52 53 54 55 | |
406 | ||
407 | EOF |