add the add_file_magic() class method
[imager.git] / t / 200-file / 100-files.t
CommitLineData
63e0dc02
TC
1#!perl -w
2
3# This file is for testing file functionality that is independent of
4# the file format
5
6use strict;
504721f3 7use Test::More;
63e0dc02
TC
8use Imager;
9
40e78f96
TC
10-d "testout" or mkdir "testout";
11
cc59eadc 12Imager->open_log(log => "testout/t1000files.log");
63e0dc02
TC
13
14SKIP:
15{
bb7a34c3
TC
16 # Test that i_test_format_probe() doesn't pollute stdout
17
63e0dc02
TC
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
30use Imager;
31use strict;
32my $file = shift or die "No file supplied";
33open FH, "< $file" or die "Cannot open file: $!";
34binmode FH;
35my $io = Imager::io_new_fd(fileno(FH));
36Imager::i_test_format_probe($io, -1);
37PERL
38 close SCRIPT;
39 my $perl = $^X;
40 $perl = qq/"$perl"/ if $perl =~ / /;
41
42 print "# script: $test_script\n";
5664d5c8 43 my $cmd = "$perl -Mblib $test_script t/200-file/100-files.t";
63e0dc02
TC
44 print "# command: $cmd\n";
45
46 my $out = `$cmd`;
47 is($?, 0, "command successful");
48 is($out, '', "output should be empty");
49}
50
77157728
TC
51# test the file limit functions
52# by default the limits are zero (unlimited)
53print "# image file limits\n";
8d14daab 54is_deeply([ Imager->get_file_limits() ], [0, 0, 0x40000000 ],
77157728
TC
55 "check defaults");
56ok(Imager->set_file_limits(width=>100), "set only width");
8d14daab 57is_deeply([ Imager->get_file_limits() ], [100, 0, 0x40000000 ],
77157728
TC
58 "check width set");
59ok(Imager->set_file_limits(height=>150, bytes=>10000),
60 "set height and bytes");
61is_deeply([ Imager->get_file_limits() ], [ 100, 150, 10000 ],
62 "check all values now set");
e1558ffe
TC
63ok(Imager->check_file_limits(width => 100, height => 30),
64 "check 100 x 30 (def channels, sample_size) ok")
65 or diag(Imager->errstr);
66ok(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);
69ok(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);
72ok(!Imager->check_file_limits(width => 100, height => 100, channels => 1, sample_size => "float"),
73 "check 100 x 100 x 1 x float should fail");
74ok(!Imager->check_file_limits(width => 100, height => 100, channels => 0),
75 "0 channels should fail");
76is(Imager->errstr, "file size limit - channels 0 out of range",
77 "check error message");
78ok(!Imager->check_file_limits(width => 0, height => 100),
79 "0 width should fail");
80is(Imager->errstr, "file size limit - image width of 0 is not positive",
81 "check error message");
82ok(!Imager->check_file_limits(width => 100, height => 0),
83 "0 height should fail");
84is(Imager->errstr, "file size limit - image height of 0 is not positive",
85 "check error message");
86ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 0),
87 "0 sample_size should fail");
88is(Imager->errstr, "file size limit - sample_size 0 out of range",
89 "check error message");
90ok(!Imager->check_file_limits(width => 10, height => 10, sample_size => 1000),
91 "1000 sample_size should fail");
92is(Imager->errstr, "file size limit - sample_size 1000 out of range",
93 "check error message");
77157728
TC
94ok(Imager->set_file_limits(reset=>1, height => 99),
95 "set height and reset");
85cae6e7 96is_deeply([ Imager->get_file_limits() ], [ 0, 99, 0x40000000 ],
77157728
TC
97 "check only height is set");
98ok(Imager->set_file_limits(reset=>1),
99 "just reset");
85cae6e7 100is_deeply([ Imager->get_file_limits() ], [ 0, 0, 0x40000000 ],
77157728 101 "check all are reset");
db7a8754 102
e1558ffe
TC
103# bad parameters
104is_deeply([ Imager->check_file_limits() ], [],
105 "missing size paramaters");
106is(Imager->errstr, "check_file_limits: width must be defined",
107 "check message");
108is_deeply([ Imager->check_file_limits(width => 100.5) ], [],
109 "non-integer parameter");
110is(Imager->errstr, "check_file_limits: width must be a positive integer",
111 "check message");
112
5970bd39
TC
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");
07b0697b 136 like(Imager->errstr, qr(^format 'bad' not supported - formats .* available for reading - This module fails to load loading Imager/File/BAD.pm$),
5970bd39
TC
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");
07b0697b 144 like($im->errstr, qr(^format 'bad' not supported - formats .* available for writing - This module fails to load loading Imager/File/BAD.pm$),
5970bd39
TC
145 "check error message");
146 }
147}
148
1136f089
TC
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)");
9d264849
TC
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");
1136f089
TC
169}
170
db7a8754
TC
171# check file type probe
172probe_ok("49492A41", undef, "not quite tiff");
173probe_ok("4D4D0041", undef, "not quite tiff");
174probe_ok("49492A00", "tiff", "tiff intel");
175probe_ok("4D4D002A", "tiff", "tiff motorola");
176probe_ok("474946383961", "gif", "gif 89");
177probe_ok("474946383761", "gif", "gif 87");
ea1136fc
TC
178probe_ok(<<TGA, "tga", "TGA");
17900 00 0A 00 00 00 00 00 00 00 00 00 96 00 96 00
18018 20 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
18100 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
18200 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
183TGA
184
c5a24cca
TC
185probe_ok(<<TGA, "tga", "TGA 32-bit");
18600 00 0A 00 00 00 00 00 00 00 00 00 0A 00 0A 00
18720 08 84 00 00 00 00 84 FF FF FF FF 84 00 00 00
18800 84 FF FF FF FF 84 00 00 00 00 84 FF FF FF FF
189TGA
190
ea1136fc
TC
191probe_ok(<<ICO, "ico", "Windows Icon");
19200 00 01 00 02 00 20 20 10 00 00 00 00 00 E8 02
19300 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
19400 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
195ICO
db7a8754 196
681d28fc
TC
197probe_ok(<<ICO, "cur", "Windows Cursor");
19800 00 02 00 02 00 20 20 10 00 00 00 00 00 E8 02
19900 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
20000 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
201ICO
202
d5477d3d 203probe_ok(<<SGI, "sgi", "SGI RGB");
8b302e44
TC
20401 DA 01 01 00 03 00 96 00 96 00 03 00 00 00 00
20500 00 00 FF 00 00 00 00 6E 6F 20 6E 61 6D 65 00
20600 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
d5477d3d 207SGI
8b302e44
TC
208
209probe_ok(<<ILBM, "ilbm", "ILBM");
21046 4F 52 4D 00 00 60 7A 49 4C 42 4D 42 4D 48 44
21100 00 00 14 00 96 00 96 00 00 00 00 18 00 01 80
21200 00 0A 0A 00 96 00 96 42 4F 44 59 00 00 60 51
213ILBM
214
215probe_ok(<<XPM, "xpm", "XPM");
2162F 2A 20 58 50 4D 20 2A 2F 0A 73 74 61 74 69 63
21720 63 68 61 72 20 2A 6E 6F 6E 61 6D 65 5B 5D 20
2183D 20 7B 0A 2F 2A 20 77 69 64 74 68 20 68 65 69
219XPM
220
221probe_ok(<<PCX, "pcx", 'PCX');
2220A 05 01 08 00 00 00 00 95 00 95 00 96 00 96 00
22300 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
22400 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
225PCX
226
227probe_ok(<<FITS, "fits", "FITS");
22853 49 4D 50 4C 45 20 20 3D 20 20 20 20 20 20 20
22920 20 20 20 20 20 20 20 20 20 20 20 20 54 20 20
23020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
231FITS
232
233probe_ok(<<PSD, "psd", "Photoshop");
23438 42 50 53 00 01 00 00 00 00 00 00 00 06 00 00
23500 3C 00 00 00 96 00 08 00 03 00 00 00 00 00 00
2360B E6 38 42 49 4D 03 ED 00 00 00 00 00 10 00 90
237PSD
238
239probe_ok(<<EPS, "eps", "Encapsulated Postscript");
24025 21 50 53 2D 41 64 6F 62 65 2D 32 2E 30 20 45
24150 53 46 2D 32 2E 30 0A 25 25 43 72 65 61 74 6F
24272 3A 20 70 6E 6D 74 6F 70 73 0A 25 25 54 69 74
243EPS
244
681d28fc
TC
245probe_ok(<<UTAH, "utah", "Utah RLE");
24652 CC 00 00 00 00 0A 00 0A 00 0A 03 08 00 08 00
2472F 00 48 49 53 54 4F 52 59 3D 70 6E 6D 74 6F 72
2486C 65 20 6F 6E 20 54 68 75 20 4D 61 79 20 31 31
24920 31 36 3A 33 35 3A 34 33 20 32 30 30 36 0A 09
250UTAH
251
603dfac7
TC
252probe_ok(<<XWD, "xwd", "X Window Dump");
25300 00 00 69 00 00 00 07 00 00 00 02 00 00 00 18
25400 00 01 E4 00 00 01 3C 00 00 00 00 00 00 00 00
25500 00 00 20 00 00 00 00 00 00 00 20 00 00 00 20
25600 00 07 90 00 00 00 04 00 FF 00 00 00 00 FF 00
257XWD
258
33fc0c9e
TC
259probe_ok(<<GZIP, "gzip", "gzip compressed");
2601F 8B 08 08 C2 81 BD 44 02 03 49 6D 61 67 65 72
2612D 30 2E 35 31 5F 30 33 2E 74 61 72 00 EC 5B 09
26240 53 C7 BA 9E 24 AC 01 D9 44 04 44 08 8B B2 8A
263C9 C9 42 92 56 41 50 20 A0 02 41 41 01 17 48 80
264GZIP
265
266probe_ok(<<BZIP2, "bzip2", "bzip2 compressed");
26742 5A 68 39 31 41 59 26 53 59 0F D8 8C 09 00 03
26828 FF FF FF FF FB 7F FB 77 FF EF BF 6B 7F BE FF
269FF DF EE C8 0F FF F3 FF FF FF FC FF FB B1 FF FB
270F4 07 DF D0 03 B8 03 60 31 82 05 2A 6A 06 83 20
271BZIP2
272
bca6a3d5
TC
273probe_ok(<<WEBP, "webp", "Google WEBP");
27452 49 46 46 2C 99 00 00 57 45 42 50 56 50 38 20
27520 99 00 00 70 7A 02 9D 01 2A E0 01 80 02 00 87
27608 85 85 88 85 84 88 88 83 AF E2 F7 64 1F 98 55
2771B 6A 70 F5 8A 45 09 95 0C 09 7E 25 D9 2E 46 44
27807 84 FB 01 FD 2C 8A 2F 97 CC ED DB 50 0F 11 3B
279WEBP
280
281probe_ok(<<JPEG2K, "jp2", "JPEG 2000");
28200 00 00 0C 6A 50 20 20 0D 0A 87 0A 00 00 00 14
28366 74 79 70 6A 70 32 20 00 00 00 00 6A 70 32 20
28400 00 00 2D 6A 70 32 68 00 00 00 16 69 68 64 72
28500 00 02 80 00 00 01 E0 00 03 07 07 00 00 00 00
28600 0F 63 6F 6C 72 01 00 00 00 00 00 10 00 00 00
28700 6A 70 32 63 FF 4F FF 51 00 2F 00 00 00 00 01
288JPEG2K
289
1facb357
TC
290probe_ok(<<FLIF, "flif", "FLIF");
29146 4C 49 46 44 31 83 7F 83 7F 00 A0 03 AF B0 B1
292E8 03 37 FF F7 D5 C2 D8 B7 D5 58 59 6E D9 71 8C
2930F A9 88 B4 1C B1 7F C0 2E FB 8C 7D 90 B6 04 DF
294CF 3A FF 56 5D FF 67 87 CE 9C 0E D6 69 CD 1F EF
295FLIF
296
b7028a2e
TC
297ok(Imager->add_file_magic(name => 'testtype',
298 bits => " testtype",
299 mask => " xxxxxxxx"),
300 "add magic");
301
302probe_ok(<<TESTTYPE, "testtype", "Test adding a format with magic");
30346 4C 49 46 74 65 73 74 74 79 70 65 03 AF B0 B1
304E8 03 37 FF F7 D5 C2 D8 B7 D5 58 59 6E D9 71 8C
3050F A9 88 B4 1C B1 7F C0 2E FB 8C 7D 90 B6 04 DF
306CF 3A FF 56 5D FF 67 87 CE 9C 0E D6 69 CD 1F EF
307TESTTYPE
308
4f21e06e
TC
309{ # RT 72475
310 # check error messages from read/read_multi
311 my $data = "nothing useful";
312 my @mult_data = Imager->read_multi(data => $data);
313 is(@mult_data, 0, "read_multi with non-image input data should fail");
314 is(Imager->errstr,
315 "type parameter missing and it couldn't be determined from the file contents",
316 "check the error message");
317
5664d5c8 318 my @mult_file = Imager->read_multi(file => "t/200-file/100-files.t");
4f21e06e
TC
319 is(@mult_file, 0, "read_multi with non-image filename should fail");
320 is(Imager->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 my $im = Imager->new;
325 ok(!$im->read(data => $data), "read from non-image data should fail");
326 is($im->errstr,
327 "type parameter missing and it couldn't be determined from the file contents",
328 "check the error message");
329
5664d5c8 330 ok(!$im->read(file => "t/200-file/100-files.t"),
4f21e06e
TC
331 "read from non-image file should fail");
332 is($im->errstr,
333 "type parameter missing and it couldn't be determined from the file contents or file name",
334 "check the error message");
335}
336
337{
338 # test def_guess_type
339 my @tests =
340 (
341 pnm => "pnm",
342 GIF => "gif",
343 tif => "tiff",
344 TIFF => "tiff",
345 JPG => "jpeg",
346 rle => "utah",
347 bmp => "bmp",
348 dib => "bmp",
349 rgb => "sgi",
350 BW => "sgi",
351 TGA => "tga",
352 CUR => "cur",
353 ico => "ico",
354 ILBM => "ilbm",
355 pcx => "pcx",
356 psd => "psd",
504721f3 357 webp => "webp",
4f21e06e
TC
358 );
359
360 while (my ($ext, $expect) = splice(@tests, 0, 2)) {
361 my $filename = "foo.$ext";
362 is(Imager::def_guess_type($filename), $expect,
363 "type for $filename should be $expect");
364 }
504721f3
TC
365 Imager->add_type_extensions("x123", "x321");
366 is(Imager::def_guess_type("foo.x321"), "x123",
367 "test adding a file type works");
4f21e06e
TC
368}
369
cc59eadc
TC
370Imager->close_log;
371
504721f3
TC
372done_testing();
373
cc59eadc
TC
374unless ($ENV{IMAGER_KEEP_FILES}) {
375 unlink "testout/t1000files.log";
376}
377
db7a8754
TC
378sub probe_ok {
379 my ($packed, $exp_type, $name) = @_;
380
381 my $builder = Test::Builder->new;
ea1136fc 382 $packed =~ tr/ \r\n//d; # remove whitespace used for layout
db7a8754
TC
383 my $data = pack("H*", $packed);
384
385 my $io = Imager::io_new_buffer($data);
b7028a2e 386 my $result = Imager::_test_format($io);
db7a8754
TC
387
388 return $builder->is_eq($result, $exp_type, $name)
389}