928dce323ed8fcbfa980059bfdcdcf5d1055f4cc
[imager.git] / t / 200-file / 100-files.t
1 #!perl -w
2
3 # This file is for testing file functionality that is independent of
4 # the file format
5
6 use strict;
7 use Test::More;
8 use Imager;
9
10 -d "testout" or mkdir "testout";
11
12 Imager->open_log(log => "testout/t1000files.log");
13
14 SKIP:
15 {
16   # Test that i_test_format_probe() doesn't pollute stdout
17
18   # Initally I tried to write this test using open to redirect files,
19   # but there was a buffering problem that made it so the data wasn't
20   # being written to the output file.  This external perl call avoids
21   # that problem
22
23   my $test_script = 'testout/t1000files_probe.pl';
24
25   # build a temp test script to use
26   ok(open(SCRIPT, "> $test_script"), "open test script")
27     or skip("no test script $test_script: $!", 2);
28   print SCRIPT <<'PERL';
29 #!perl
30 use Imager;
31 use strict;
32 my $file = shift or die "No file supplied";
33 open FH, "< $file" or die "Cannot open file: $!";
34 binmode FH;
35 my $io = Imager::io_new_fd(fileno(FH));
36 Imager::i_test_format_probe($io, -1);
37 PERL
38   close SCRIPT;
39   my $perl = $^X;
40   $perl = qq/"$perl"/ if $perl =~ / /;
41   
42   print "# script: $test_script\n";
43   my $cmd = "$perl -Mblib $test_script t/200-file/100-files.t";
44   print "# command: $cmd\n";
45
46   my $out = `$cmd`;
47   is($?, 0, "command successful");
48   is($out, '', "output should be empty");
49 }
50
51 # test the file limit functions
52 # by default the limits are zero (unlimited)
53 print "# image file limits\n";
54 is_deeply([ Imager->get_file_limits() ], [0, 0, 0x40000000 ],
55           "check defaults");
56 ok(Imager->set_file_limits(width=>100), "set only width");
57 is_deeply([ Imager->get_file_limits() ], [100, 0, 0x40000000 ],
58           "check width set");
59 ok(Imager->set_file_limits(height=>150, bytes=>10000),
60    "set height and bytes");
61 is_deeply([ Imager->get_file_limits() ], [ 100, 150, 10000 ],
62           "check all values now set");
63 ok(Imager->check_file_limits(width => 100, height => 30),
64    "check 100 x 30 (def channels, sample_size) ok")
65   or diag(Imager->errstr);
66 ok(Imager->check_file_limits(width => 100, height => 100, channels => 1),
67    "check 100 x 100 x 1 (def sample_size) ok")
68   or diag(Imager->errstr);
69 ok(Imager->check_file_limits(width => 100, height => 100, channels => 1),
70    "check 100 x 100 x 1 (def sample_size) ok")
71   or diag(Imager->errstr);
72 ok(!Imager->check_file_limits(width => 100, height => 100, channels => 1, sample_size => "float"),
73    "check 100 x 100 x 1 x float should fail");
74 ok(!Imager->check_file_limits(width => 100, height => 100, channels => 0),
75    "0 channels should fail");
76 is(Imager->errstr, "file size limit - channels 0 out of range",
77    "check error message");
78 ok(!Imager->check_file_limits(width => 0, height => 100),
79    "0 width should fail");
80 is(Imager->errstr, "file size limit - image width of 0 is not positive",
81    "check error message");
82 ok(!Imager->check_file_limits(width => 100, height => 0),
83    "0 height should fail");
84 is(Imager->errstr, "file size limit - image height of 0 is not positive",
85    "check error message");
86 ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 0),
87    "0 sample_size should fail");
88 is(Imager->errstr, "file size limit - sample_size 0 out of range",
89    "check error message");
90 ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 1000),
91    "1000 sample_size should fail");
92 is(Imager->errstr, "file size limit - sample_size 1000 out of range",
93    "check error message");
94 ok(Imager->set_file_limits(reset=>1, height => 99),
95    "set height and reset");
96 is_deeply([ Imager->get_file_limits() ], [ 0, 99, 0x40000000 ],
97           "check only height is set");
98 ok(Imager->set_file_limits(reset=>1),
99    "just reset");
100 is_deeply([ Imager->get_file_limits() ], [ 0, 0, 0x40000000 ],
101           "check all are reset");
102
103 # bad parameters
104 is_deeply([ Imager->check_file_limits() ], [],
105           "missing size paramaters");
106 is(Imager->errstr, "check_file_limits: width must be defined",
107    "check message");
108 is_deeply([ Imager->check_file_limits(width => 100.5) ], [],
109           "non-integer parameter");
110 is(Imager->errstr, "check_file_limits: width must be a positive integer",
111    "check message");
112
113 # test error handling for loading file handers
114 {
115   # first, no module at all
116   {
117     my $data = "abc";
118     ok(!Imager->new(data => $data, filetype => "unknown"),
119        "try to read an unknown file type");
120    like(Imager->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNReader.pm$),
121         "check error message");
122   }
123   {
124     my $data;
125     my $im = Imager->new(xsize => 10, ysize => 10);
126     ok(!$im->write(data => \$data, type => "unknown"),
127        "try to write an unknown file type");
128    like($im->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNWriter.pm$),
129         "check error message");
130   }
131   push @INC, "t/t1000lib";
132   {
133     my $data = "abc";
134     ok(!Imager->new(data => $data, filetype => "bad"),
135        "try to read an bad (other load failure) file type");
136    like(Imager->errstr, qr(^format 'bad' not supported - formats .* available for reading - This module fails to load loading Imager/File/BAD.pm$),
137         "check error message");
138   }
139   {
140     my $data;
141     my $im = Imager->new(xsize => 10, ysize => 10);
142     ok(!$im->write(data => \$data, type => "bad"),
143        "try to write an bad file type");
144    like($im->errstr, qr(^format 'bad' not supported - formats .* available for writing - This module fails to load loading Imager/File/BAD.pm$),
145         "check error message");
146   }
147 }
148
149 { # test empty image handling for write()/write_multi()
150   my $empty = Imager->new;
151   my $data;
152   ok(!$empty->write(data => \$data, type => "pnm"),
153      "fail to write an empty image");
154   is($empty->errstr, "write: empty input image", "check error message");
155   my $good = Imager->new(xsize => 1, ysize => 1);
156   ok(!Imager->write_multi({ data => \$data, type => "pnm" }, $good, $empty),
157      "fail to write_multi an empty image");
158   is(Imager->errstr, "write_multi: empty input image (image 2)");
159   Imager->_set_error("");
160   my $not_imager = bless {}, "Foo";
161   ok(!Imager->write_multi({ data => \$data, type => "pnm" }, $not_imager),
162      "fail to write_multi() a non-Imager object");
163   is(Imager->errstr, "write_multi: image 1 is not an Imager image object",
164      "check message");
165   ok(!Imager->write_multi({ data => \$data, type => "pnm" }, "Imager"),
166      "fail to write_multi() 'Imager' string");
167   is(Imager->errstr, "write_multi: image 1 is not an Imager image object",
168      "check message");
169 }
170
171 # check file type probe
172 probe_ok("49492A41", undef, "not quite tiff");
173 probe_ok("4D4D0041", undef, "not quite tiff");
174 probe_ok("49492A00", "tiff", "tiff intel");
175 probe_ok("4D4D002A", "tiff", "tiff motorola");
176 probe_ok("474946383961", "gif", "gif 89");
177 probe_ok("474946383761", "gif", "gif 87");
178 probe_ok(<<TGA, "tga", "TGA");
179 00 00 0A 00 00 00 00 00 00 00 00 00 96 00 96 00
180 18 20 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
181 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
182 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
183 TGA
184
185 probe_ok(<<TGA, "tga", "TGA 32-bit");
186 00 00 0A 00 00 00 00 00 00 00 00 00 0A 00 0A 00
187 20 08 84 00 00 00 00 84 FF FF FF FF 84 00 00 00
188 00 84 FF FF FF FF 84 00 00 00 00 84 FF FF FF FF
189 TGA
190
191 probe_ok(<<ICO, "ico", "Windows Icon");
192 00 00 01 00 02 00 20 20 10 00 00 00 00 00 E8 02
193 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
194 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
195 ICO
196
197 probe_ok(<<ICO, "cur", "Windows Cursor");
198 00 00 02 00 02 00 20 20 10 00 00 00 00 00 E8 02
199 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
200 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
201 ICO
202
203 probe_ok(<<SGI, "sgi", "SGI RGB");
204 01 DA 01 01 00 03 00 96 00 96 00 03 00 00 00 00 
205 00 00 00 FF 00 00 00 00 6E 6F 20 6E 61 6D 65 00
206 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
207 SGI
208
209 probe_ok(<<ILBM, "ilbm", "ILBM");
210 46 4F 52 4D 00 00 60 7A 49 4C 42 4D 42 4D 48 44
211 00 00 00 14 00 96 00 96 00 00 00 00 18 00 01 80
212 00 00 0A 0A 00 96 00 96 42 4F 44 59 00 00 60 51
213 ILBM
214
215 probe_ok(<<XPM, "xpm", "XPM");
216 2F 2A 20 58 50 4D 20 2A 2F 0A 73 74 61 74 69 63
217 20 63 68 61 72 20 2A 6E 6F 6E 61 6D 65 5B 5D 20
218 3D 20 7B 0A 2F 2A 20 77 69 64 74 68 20 68 65 69
219 XPM
220
221 probe_ok(<<PCX, "pcx", 'PCX');
222 0A 05 01 08 00 00 00 00 95 00 95 00 96 00 96 00
223 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
224 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
225 PCX
226
227 probe_ok(<<FITS, "fits", "FITS");
228 53 49 4D 50 4C 45 20 20 3D 20 20 20 20 20 20 20 
229 20 20 20 20 20 20 20 20 20 20 20 20 20 54 20 20 
230 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 
231 FITS
232
233 probe_ok(<<PSD, "psd", "Photoshop");
234 38 42 50 53 00 01 00 00 00 00 00 00 00 06 00 00
235 00 3C 00 00 00 96 00 08 00 03 00 00 00 00 00 00
236 0B E6 38 42 49 4D 03 ED 00 00 00 00 00 10 00 90
237 PSD
238
239 probe_ok(<<EPS, "eps", "Encapsulated Postscript");
240 25 21 50 53 2D 41 64 6F 62 65 2D 32 2E 30 20 45
241 50 53 46 2D 32 2E 30 0A 25 25 43 72 65 61 74 6F
242 72 3A 20 70 6E 6D 74 6F 70 73 0A 25 25 54 69 74
243 EPS
244
245 probe_ok(<<UTAH, "utah", "Utah RLE");
246 52 CC 00 00 00 00 0A 00 0A 00 0A 03 08 00 08 00 
247 2F 00 48 49 53 54 4F 52 59 3D 70 6E 6D 74 6F 72 
248 6C 65 20 6F 6E 20 54 68 75 20 4D 61 79 20 31 31 
249 20 31 36 3A 33 35 3A 34 33 20 32 30 30 36 0A 09 
250 UTAH
251
252 probe_ok(<<XWD, "xwd", "X Window Dump");
253 00 00 00 69 00 00 00 07 00 00 00 02 00 00 00 18
254 00 00 01 E4 00 00 01 3C 00 00 00 00 00 00 00 00
255 00 00 00 20 00 00 00 00 00 00 00 20 00 00 00 20
256 00 00 07 90 00 00 00 04 00 FF 00 00 00 00 FF 00
257 XWD
258
259 probe_ok(<<GZIP, "gzip", "gzip compressed");
260 1F 8B 08 08 C2 81 BD 44 02 03 49 6D 61 67 65 72
261 2D 30 2E 35 31 5F 30 33 2E 74 61 72 00 EC 5B 09
262 40 53 C7 BA 9E 24 AC 01 D9 44 04 44 08 8B B2 8A
263 C9 C9 42 92 56 41 50 20 A0 02 41 41 01 17 48 80
264 GZIP
265
266 probe_ok(<<BZIP2, "bzip2", "bzip2 compressed");
267 42 5A 68 39 31 41 59 26 53 59 0F D8 8C 09 00 03
268 28 FF FF FF FF FB 7F FB 77 FF EF BF 6B 7F BE FF
269 FF DF EE C8 0F FF F3 FF FF FF FC FF FB B1 FF FB
270 F4 07 DF D0 03 B8 03 60 31 82 05 2A 6A 06 83 20
271 BZIP2
272
273 probe_ok(<<WEBP, "webp", "Google WEBP");
274 52 49 46 46 2C 99 00 00 57 45 42 50 56 50 38 20
275 20 99 00 00 70 7A 02 9D 01 2A E0 01 80 02 00 87
276 08 85 85 88 85 84 88 88 83 AF E2 F7 64 1F 98 55
277 1B 6A 70 F5 8A 45 09 95 0C 09 7E 25 D9 2E 46 44
278 07 84 FB 01 FD 2C 8A 2F 97 CC ED DB 50 0F 11 3B
279 WEBP
280
281 probe_ok(<<JPEG2K, "jp2", "JPEG 2000");
282 00 00 00 0C 6A 50 20 20 0D 0A 87 0A 00 00 00 14
283 66 74 79 70 6A 70 32 20 00 00 00 00 6A 70 32 20
284 00 00 00 2D 6A 70 32 68 00 00 00 16 69 68 64 72
285 00 00 02 80 00 00 01 E0 00 03 07 07 00 00 00 00
286 00 0F 63 6F 6C 72 01 00 00 00 00 00 10 00 00 00
287 00 6A 70 32 63 FF 4F FF 51 00 2F 00 00 00 00 01
288 JPEG2K
289
290 probe_ok(<<FLIF, "flif", "FLIF");
291 46 4C 49 46 44 31 83 7F 83 7F 00 A0 03 AF B0 B1
292 E8 03 37 FF F7 D5 C2 D8 B7 D5 58 59 6E D9 71 8C
293 0F A9 88 B4 1C B1 7F C0 2E FB 8C 7D 90 B6 04 DF
294 CF 3A FF 56 5D FF 67 87 CE 9C 0E D6 69 CD 1F EF
295 FLIF
296
297 { # RT 72475
298   # check error messages from read/read_multi
299   my $data = "nothing useful";
300   my @mult_data = Imager->read_multi(data => $data);
301   is(@mult_data, 0, "read_multi with non-image input data should fail");
302   is(Imager->errstr,
303      "type parameter missing and it couldn't be determined from the file contents",
304      "check the error message");
305
306   my @mult_file = Imager->read_multi(file => "t/200-file/100-files.t");
307   is(@mult_file, 0, "read_multi with non-image filename should fail");
308   is(Imager->errstr,
309      "type parameter missing and it couldn't be determined from the file contents or file name",
310      "check the error message");
311
312   my $im = Imager->new;
313   ok(!$im->read(data => $data), "read from non-image data should fail");
314   is($im->errstr,
315      "type parameter missing and it couldn't be determined from the file contents",
316      "check the error message");
317
318   ok(!$im->read(file => "t/200-file/100-files.t"),
319      "read from non-image file should fail");
320   is($im->errstr,
321      "type parameter missing and it couldn't be determined from the file contents or file name",
322      "check the error message");
323 }
324
325 {
326   # test def_guess_type
327   my @tests =
328     (
329      pnm => "pnm",
330      GIF => "gif",
331      tif => "tiff",
332      TIFF => "tiff",
333      JPG => "jpeg",
334      rle => "utah",
335      bmp => "bmp",
336      dib => "bmp",
337      rgb => "sgi",
338      BW => "sgi",
339      TGA => "tga",
340      CUR => "cur",
341      ico => "ico",
342      ILBM => "ilbm",
343      pcx => "pcx",
344      psd => "psd",
345      webp => "webp",
346     );
347
348   while (my ($ext, $expect) = splice(@tests, 0, 2)) {
349     my $filename = "foo.$ext";
350     is(Imager::def_guess_type($filename), $expect,
351        "type for $filename should be $expect");
352   }
353   Imager->add_type_extensions("x123", "x321");
354   is(Imager::def_guess_type("foo.x321"), "x123",
355      "test adding a file type works");
356 }
357
358 Imager->close_log;
359
360 done_testing();
361
362 unless ($ENV{IMAGER_KEEP_FILES}) {
363   unlink "testout/t1000files.log";
364 }
365
366 sub probe_ok {
367   my ($packed, $exp_type, $name) = @_;
368
369   my $builder = Test::Builder->new;
370   $packed =~ tr/ \r\n//d; # remove whitespace used for layout
371   my $data = pack("H*", $packed);
372
373   my $io = Imager::io_new_buffer($data);
374   my $result = Imager::i_test_format_probe($io, -1);
375
376   return $builder->is_eq($result, $exp_type, $name)
377 }