- Finished/rewrote Arnar's old SGI RGB file format support, so Imager
[imager.git] / SGI / t / 10read.t
1 #!perl -w
2 use strict;
3 use Imager;
4 use Imager::Test qw(is_image is_color3);
5 use Test::More tests => 103;
6
7 -d 'testout' or mkdir 'testout';
8
9 Imager::init_log('testout/10read.log', 2);
10
11 {
12   my $im_verb = Imager->new;
13   ok($im_verb->read(file => 'testimg/verb.rgb'), "read verbatim")
14     or print "# ", $im_verb->errstr, "\n";
15   is($im_verb->getchannels, 3, "check channels");
16   is($im_verb->getwidth, 20, "check width");
17   is($im_verb->getheight, 20, "check height");
18   is_color3($im_verb->getpixel(x => 0, 'y' => 0), 255, 0, 0, "check 0,0");
19   is_color3($im_verb->getpixel(x => 1, 'y' => 2), 255, 255, 0, "check 0,2");
20   is_color3($im_verb->getpixel(x => 2, 'y' => 4), 0, 255, 255, "check 2,5");
21   is($im_verb->tags(name => 'i_format'), 'sgi', "check i_format tag");
22   is($im_verb->tags(name => 'sgi_rle'), 0, "check sgi_rgb");
23   is($im_verb->tags(name => 'sgi_pixmin'), 0, "check pixmin");
24   is($im_verb->tags(name => 'sgi_pixmax'), 255, "check pixmax");
25   is($im_verb->tags(name => 'sgi_bpc'), 1, "check bpc");
26   is($im_verb->tags(name => 'i_comment'), 'test image', 
27      "check name string");
28
29   my $im_rle = Imager->new;
30   ok($im_rle->read(file => 'testimg/rle.rgb'), "read rle")
31     or print "# ", $im_rle->errstr, "\n";
32   is($im_rle->tags(name => 'sgi_rle'), 1, "check sgi_rgb");
33
34   my $im_rleagr = Imager->new;
35   ok($im_rleagr->read(file => 'testimg/rleagr.rgb'), "read rleagr")
36     or print "# ", $im_rleagr->errstr, "\n";
37
38   my $im6 = Imager->new;
39   ok($im6->read(file => 'testimg/verb6.rgb'), "read verbatim 6-bit")
40     or print "# ", $im6->errstr, "\n";
41   is($im6->tags(name => 'sgi_pixmax'), 63, "check pixmax");
42
43   is_image($im_verb, $im_rle, "compare verbatim to rle");
44   is_image($im_verb, $im_rleagr, "compare verbatim to rleagr");
45   is_image($im_verb, $im6, "compare verbatim to verb 6-bit");
46
47   my $im_verb12 = Imager->new;
48   ok($im_verb12->read(file => 'testimg/verb12.rgb'), "read verbatim 12")
49     or print "# ", $im_verb12->errstr, "\n";
50   is($im_verb12->bits, 16, "check bits on verb12");
51   is($im_verb12->tags(name => 'sgi_pixmax'), 4095, "check pixmax");
52
53   my $im_verb16 = Imager->new;
54   ok($im_verb16->read(file => 'testimg/verb16.rgb'), "read verbatim 16")
55     or print "# ", $im_verb16->errstr, "\n";
56   is($im_verb16->bits, 16, "check bits on verb16");
57   is($im_verb16->tags(name => 'sgi_pixmax'), 65535, "check pixmax");
58   
59   is_image($im_verb, $im_verb12, "compare verbatim to verb12");
60   is_image($im_verb, $im_verb16, "compare verbatim to verb16");
61
62   my $im_rle6 = Imager->new;
63   ok($im_rle6->read(file => 'testimg/rle6.rgb'), "read rle 6 bit");
64   is($im_rle6->tags(name => 'sgi_pixmax'), 63, 'check pixmax');
65   is_image($im_verb, $im_rle6, 'compare verbatim to rle6');
66   
67   my $im_rle12 = Imager->new;
68   ok($im_rle12->read(file => 'testimg/rle12.rgb'), 'read rle 12 bit')
69     or print "# ", $im_rle12->errstr, "\n";
70   is($im_rle12->tags(name => 'sgi_pixmax'), 4095, 'check pixmax');
71   is_image($im_verb, $im_rle12, 'compare verbatim to rle12');
72
73   my $im_rle16 = Imager->new;
74   ok($im_rle16->read(file => 'testimg/rle16.rgb'), 'read rle 16 bit')
75     or print "# ", $im_rle16->errstr, "\n";
76   is($im_rle16->tags(name => 'sgi_pixmax'), 65535, 'check pixmax');
77   is($im_rle16->tags(name => 'sgi_bpc'), 2, "check bpc");
78   is_image($im_verb, $im_rle16, 'compare verbatim to rle16');
79 }
80
81 {
82   # short read tests, each is source file, limit, match, description
83   my @tests =
84     (
85      [ 
86       'verb.rgb', 100, 
87       'SGI image: could not read header', 'header',
88      ],
89      [ 
90       'verb.rgb', 512, 
91        'SGI image: cannot read image data', 
92        'verbatim image data' 
93      ],
94      [
95       'rle.rgb', 512,
96       'SGI image: short read reading RLE start table',
97       'rle start table'
98      ],
99      [
100       'rle.rgb', 752,
101       'SGI image: short read reading RLE length table',
102       'rle length table'
103      ],
104      [
105       'rle.rgb', 0x510,
106       "SGI image: cannot read RLE data",
107       'read rle data'
108      ],
109      [
110       'rle.rgb', 0x50E,
111       "SGI image: cannot seek to RLE data",
112       'seek rle data'
113      ],
114      [
115       'verb16.rgb', 512,
116       'SGI image: cannot read image data',
117       'read image data (16-bit)'
118      ],
119      [
120       'rle16.rgb', 512,
121       'SGI image: short read reading RLE start table',
122       'rle start table (16-bit)',
123      ],
124      [
125       'rle16.rgb', 0x42f,
126       'SGI image: cannot seek to RLE data',
127       'seek RLE data (16-bit)'
128      ],
129      [
130       'rle16.rgb', 0x64A,
131       'SGI image: cannot read RLE data',
132       'read rle image data (16-bit)'
133      ],
134     );
135   for my $test (@tests) {
136     my ($src, $size, $match, $desc) = @$test;
137     open SRC, "< testimg/$src"
138       or die "Cannot open testimg/$src: $!";
139     binmode SRC;
140     my $data;
141     read(SRC, $data, $size) == $size
142       or die "Could not read $size bytes from $src";
143     close SRC;
144     my $im = Imager->new;
145     ok(!$im->read(data => $data, type => 'sgi'),
146        "read: $desc");
147     is($im->errstr, $match, "error match: $desc");
148   }
149 }
150
151 {
152   # each entry is: source file, patches, expected error, description
153   my @tests =
154     (
155      [
156       'verb.rgb',
157       { 0 => '00 00' },
158       'SGI image: invalid magic number',
159       'bad magic',
160      ],
161      [
162       'verb.rgb',
163       { 104 => '00 00 00 01' },
164       'SGI image: invalid value for colormap (1)',
165       'invalid colormap field',
166      ],
167      [
168       'verb.rgb',
169       { 3 => '03' },
170       'SGI image: invalid value for BPC (3)',
171       'invalid bpc field',
172      ],
173      [
174       'verb.rgb',
175       { 2 => '03' },
176       'SGI image: invalid storage type field',
177       'invalid storage type field',
178      ],
179      [
180       'verb.rgb',
181       { 4 => '00 04' },
182       'SGI image: invalid dimension field',
183       'invalid dimension field',
184      ],
185      [
186       'rle.rgb',
187       { 0x2f0 => '00 00 00 2b' },
188       'SGI image: ridiculous RLE line length 43',
189       'invalid rle length',
190      ],
191      [
192       'rle.rgb',
193       { 0x3E0 => '95' },
194       'SGI image: literal run overflows scanline',
195       'literal run overflow scanline',
196      ],
197      [
198       'rle.rgb',
199       { 0x3E0 => '87' },
200       'SGI image: literal run consumes more data than available',
201       'literal run consuming too much data',
202      ],
203      [
204       'rle.rgb',
205       { 0x3E0 => '15' },
206       'SGI image: RLE run overflows scanline',
207       'RLE run overflows scanline',
208      ],
209      [
210       'rle.rgb',
211       { 0x3E0 => '81 FF 12 00 01' },
212       'SGI image: RLE run has no data for pixel',
213       'RLE run has no data for pixel',
214      ],
215      [
216       'rle.rgb',
217       { 0x3E0 => '81 FF 12 00' },
218       'SGI image: incomplete RLE scanline',
219       'incomplete RLE scanline',
220      ],
221      [
222       'rle.rgb',
223       { 0x2F0 => '00 00 00 06' },
224       'SGI image: unused RLE data',
225       'unused RLE data',
226      ],
227      [
228       'verb.rgb',
229       { 0x0c => '00 00 00 FF 00 00 00 00' },
230       'SGI image: invalid pixmin >= pixmax',
231       'bad pixmin/pixmax',
232      ],
233      [
234       'rle16.rgb',
235       { 0x2f0 => '00 00 00 0B' },
236       'SGI image: invalid RLE length value for BPC=2',
237       'bad RLE table (length) (bpc=2)'
238      ],
239      [
240       'rle16.rgb',
241       { 0x2f0 => '00 00 00 53' },
242       'SGI image: ridiculous RLE line length 83',
243       'way too big RLE line length (16-bit)'
244      ],
245      [
246       'rle16.rgb',
247       { 0x426 => '00 95' },
248       'SGI image: literal run overflows scanline',
249       'literal overflow scanline (bpc=2)'
250      ],
251      [
252       'rle16.rgb',
253       { 0x426 => '00 93' },
254       'SGI image: literal run consumes more data than available',
255       'literal overflow data (bpc=2)'
256      ],
257      [
258       'rle16.rgb',
259       { 0x3EA => '00 15' },
260       'SGI image: RLE run overflows scanline',
261       'rle overflow scanline (bpc=2)'
262      ],
263      [
264       'rle16.rgb',
265       { 0x3EA => '00 15' },
266       'SGI image: RLE run overflows scanline',
267       'rle overflow scanline (bpc=2)'
268      ],
269      [
270       'rle16.rgb',
271       { 0x3EA => '00 83 ff ff ff ff ff ff 00 01' },
272       'SGI image: RLE run has no data for pixel',
273       'rle code no argument (bpc=2)'
274      ],
275      [
276       'rle16.rgb',
277       { 0x3EA => '00 14 ff ff 00 00' },
278       'SGI image: unused RLE data',
279       'unused RLE data (bpc=2)'
280      ],
281      [
282       'rle16.rgb',
283       { 0x3EA => '00 12 ff ff' },
284       'SGI image: incomplete RLE scanline',
285       'incomplete rle scanline (bpc=2)'
286      ],
287     );
288
289   # invalid file tests - take our original files and patch them a
290   # little to make them invalid
291     my $test_index = 0;
292   for my $test (@tests) {
293     my ($filename, $patches, $error, $desc) = @$test;
294
295     my $data = load_patched_file("testimg/$filename", $patches);
296     my $im = Imager->new;
297     ok(!$im->read(data => $data, type=>'sgi'),
298        "$test_index - $desc:should fail to read");
299     is($im->errstr, $error, "$test_index - $desc:check message");
300     ++$test_index;
301   }
302 }
303
304 sub load_patched_file {
305   my ($filename, $patches) = @_;
306
307   open IMDATA, "< $filename"
308     or die "Cannot open $filename: $!";
309   binmode IMDATA;
310   my $data = do { local $/; <IMDATA> };
311   for my $offset (keys %$patches) {
312     (my $hdata = $patches->{$offset}) =~ tr/ //d;
313     my $pdata = pack("H*", $hdata);
314     substr($data, $offset, length $pdata) = $pdata;
315   }
316
317   return $data;
318 }