t/t1000files.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 tests => 67;
   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/t1000files.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->set_file_limits(reset=>1, height => 99),
  64    "set height and reset");
  65 is_deeply([ Imager->get_file_limits() ], [ 0, 99, 0x40000000 ],
  66           "check only height is set");
  67 ok(Imager->set_file_limits(reset=>1),
  68    "just reset");
  69 is_deeply([ Imager->get_file_limits() ], [ 0, 0, 0x40000000 ],
  70           "check all are reset");
  71
  72 # test error handling for loading file handers
  73 {
  74   # first, no module at all
  75   {
  76     my $data = "abc";
  77     ok(!Imager->new(data => $data, filetype => "unknown"),
  78        "try to read an unknown file type");
  79    like(Imager->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNReader.pm$),
  80         "check error message");
  81   }
  82   {
  83     my $data;
  84     my $im = Imager->new(xsize => 10, ysize => 10);
  85     ok(!$im->write(data => \$data, type => "unknown"),
  86        "try to write an unknown file type");
  87    like($im->errstr, qr(^format 'unknown' not supported - formats .* - Can't locate Imager/File/UNKNOWN.pm or Imager/File/UNKNOWNWriter.pm$),
  88         "check error message");
  89   }
  90   push @INC, "t/t1000lib";
  91   {
  92     my $data = "abc";
  93     ok(!Imager->new(data => $data, filetype => "bad"),
  94        "try to read an bad (other load failure) file type");
  95    like(Imager->errstr, qr(^format 'bad' not supported - formats .* available for reading - This module fails to load loading Imager/File/BAD.pm$),
  96         "check error message");
  97   }
  98   {
  99     my $data;
 100     my $im = Imager->new(xsize => 10, ysize => 10);
 101     ok(!$im->write(data => \$data, type => "bad"),
 102        "try to write an bad file type");
 103    like($im->errstr, qr(^format 'bad' not supported - formats .* available for writing - This module fails to load loading Imager/File/BAD.pm$),
 104         "check error message");
 105   }
 106 }
 107
 108 # check file type probe
 109 probe_ok("49492A41", undef, "not quite tiff");
 110 probe_ok("4D4D0041", undef, "not quite tiff");
 111 probe_ok("49492A00", "tiff", "tiff intel");
 112 probe_ok("4D4D002A", "tiff", "tiff motorola");
 113 probe_ok("474946383961", "gif", "gif 89");
 114 probe_ok("474946383761", "gif", "gif 87");
 115 probe_ok(<<TGA, "tga", "TGA");
 116 00 00 0A 00 00 00 00 00 00 00 00 00 96 00 96 00
 117 18 20 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
 118 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
 119 00 00 FF 00 00 00 95 00 00 00 FF 00 00 00 95 00
 120 TGA
 121
 122 probe_ok(<<TGA, "tga", "TGA 32-bit");
 123 00 00 0A 00 00 00 00 00 00 00 00 00 0A 00 0A 00
 124 20 08 84 00 00 00 00 84 FF FF FF FF 84 00 00 00
 125 00 84 FF FF FF FF 84 00 00 00 00 84 FF FF FF FF
 126 TGA
 127
 128 probe_ok(<<ICO, "ico", "Windows Icon");
 129 00 00 01 00 02 00 20 20 10 00 00 00 00 00 E8 02
 130 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
 131 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
 132 ICO
 133
 134 probe_ok(<<ICO, "cur", "Windows Cursor");
 135 00 00 02 00 02 00 20 20 10 00 00 00 00 00 E8 02
 136 00 00 26 00 00 00 20 20 00 00 00 00 00 00 A8 08
 137 00 00 0E 03 00 00 28 00 00 00 20 00 00 00 40 00
 138 ICO
 139
 140 probe_ok(<<SGI, "sgi", "SGI RGB");
 141 01 DA 01 01 00 03 00 96 00 96 00 03 00 00 00 00
 142 00 00 00 FF 00 00 00 00 6E 6F 20 6E 61 6D 65 00
 143 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
 144 SGI
 145
 146 probe_ok(<<ILBM, "ilbm", "ILBM");
 147 46 4F 52 4D 00 00 60 7A 49 4C 42 4D 42 4D 48 44
 148 00 00 00 14 00 96 00 96 00 00 00 00 18 00 01 80
 149 00 00 0A 0A 00 96 00 96 42 4F 44 59 00 00 60 51
 150 ILBM
 151
 152 probe_ok(<<XPM, "xpm", "XPM");
 153 2F 2A 20 58 50 4D 20 2A 2F 0A 73 74 61 74 69 63
 154 20 63 68 61 72 20 2A 6E 6F 6E 61 6D 65 5B 5D 20
 155 3D 20 7B 0A 2F 2A 20 77 69 64 74 68 20 68 65 69
 156 XPM
 157
 158 probe_ok(<<PCX, "pcx", 'PCX');
 159 0A 05 01 08 00 00 00 00 95 00 95 00 96 00 96 00
 160 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
 161 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
 162 PCX
 163
 164 probe_ok(<<FITS, "fits", "FITS");
 165 53 49 4D 50 4C 45 20 20 3D 20 20 20 20 20 20 20
 166 20 20 20 20 20 20 20 20 20 20 20 20 20 54 20 20
 167 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
 168 FITS
 169
 170 probe_ok(<<PSD, "psd", "Photoshop");
 171 38 42 50 53 00 01 00 00 00 00 00 00 00 06 00 00
 172 00 3C 00 00 00 96 00 08 00 03 00 00 00 00 00 00
 173 0B E6 38 42 49 4D 03 ED 00 00 00 00 00 10 00 90
 174 PSD
 175
 176 probe_ok(<<EPS, "eps", "Encapsulated Postscript");
 177 25 21 50 53 2D 41 64 6F 62 65 2D 32 2E 30 20 45
 178 50 53 46 2D 32 2E 30 0A 25 25 43 72 65 61 74 6F
 179 72 3A 20 70 6E 6D 74 6F 70 73 0A 25 25 54 69 74
 180 EPS
 181
 182 probe_ok(<<UTAH, "utah", "Utah RLE");
 183 52 CC 00 00 00 00 0A 00 0A 00 0A 03 08 00 08 00
 184 2F 00 48 49 53 54 4F 52 59 3D 70 6E 6D 74 6F 72
 185 6C 65 20 6F 6E 20 54 68 75 20 4D 61 79 20 31 31
 186 20 31 36 3A 33 35 3A 34 33 20 32 30 30 36 0A 09
 187 UTAH
 188
 189 probe_ok(<<XWD, "xwd", "X Window Dump");
 190 00 00 00 69 00 00 00 07 00 00 00 02 00 00 00 18
 191 00 00 01 E4 00 00 01 3C 00 00 00 00 00 00 00 00
 192 00 00 00 20 00 00 00 00 00 00 00 20 00 00 00 20
 193 00 00 07 90 00 00 00 04 00 FF 00 00 00 00 FF 00
 194 XWD
 195
 196 probe_ok(<<GZIP, "gzip", "gzip compressed");
 197 1F 8B 08 08 C2 81 BD 44 02 03 49 6D 61 67 65 72
 198 2D 30 2E 35 31 5F 30 33 2E 74 61 72 00 EC 5B 09
 199 40 53 C7 BA 9E 24 AC 01 D9 44 04 44 08 8B B2 8A
 200 C9 C9 42 92 56 41 50 20 A0 02 41 41 01 17 48 80
 201 GZIP
 202
 203 probe_ok(<<BZIP2, "bzip2", "bzip2 compressed");
 204 42 5A 68 39 31 41 59 26 53 59 0F D8 8C 09 00 03
 205 28 FF FF FF FF FB 7F FB 77 FF EF BF 6B 7F BE FF
 206 FF DF EE C8 0F FF F3 FF FF FF FC FF FB B1 FF FB
 207 F4 07 DF D0 03 B8 03 60 31 82 05 2A 6A 06 83 20
 208 BZIP2
 209
 210 probe_ok(<<WEBP, "webp", "Google WEBP");
 211 52 49 46 46 2C 99 00 00 57 45 42 50 56 50 38 20
 212 20 99 00 00 70 7A 02 9D 01 2A E0 01 80 02 00 87
 213 08 85 85 88 85 84 88 88 83 AF E2 F7 64 1F 98 55
 214 1B 6A 70 F5 8A 45 09 95 0C 09 7E 25 D9 2E 46 44
 215 07 84 FB 01 FD 2C 8A 2F 97 CC ED DB 50 0F 11 3B
 216 WEBP
 217
 218 probe_ok(<<JPEG2K, "jp2", "JPEG 2000");
 219 00 00 00 0C 6A 50 20 20 0D 0A 87 0A 00 00 00 14
 220 66 74 79 70 6A 70 32 20 00 00 00 00 6A 70 32 20
 221 00 00 00 2D 6A 70 32 68 00 00 00 16 69 68 64 72
 222 00 00 02 80 00 00 01 E0 00 03 07 07 00 00 00 00
 223 00 0F 63 6F 6C 72 01 00 00 00 00 00 10 00 00 00
 224 00 6A 70 32 63 FF 4F FF 51 00 2F 00 00 00 00 01
 225 JPEG2K
 226
 227 { # RT 72475
 228   # check error messages from read/read_multi
 229   my $data = "nothing useful";
 230   my @mult_data = Imager->read_multi(data => $data);
 231   is(@mult_data, 0, "read_multi with non-image input data should fail");
 232   is(Imager->errstr,
 233      "type parameter missing and it couldn't be determined from the file contents",
 234      "check the error message");
 235
 236   my @mult_file = Imager->read_multi(file => "t/t1000files.t");
 237   is(@mult_file, 0, "read_multi with non-image filename should fail");
 238   is(Imager->errstr,
 239      "type parameter missing and it couldn't be determined from the file contents or file name",
 240      "check the error message");
 241
 242   my $im = Imager->new;
 243   ok(!$im->read(data => $data), "read from non-image data should fail");
 244   is($im->errstr,
 245      "type parameter missing and it couldn't be determined from the file contents",
 246      "check the error message");
 247
 248   ok(!$im->read(file => "t/t1000files.t"),
 249      "read from non-image file should fail");
 250   is($im->errstr,
 251      "type parameter missing and it couldn't be determined from the file contents or file name",
 252      "check the error message");
 253 }
 254
 255 {
 256   # test def_guess_type
 257   my @tests =
 258     (
 259      pnm => "pnm",
 260      GIF => "gif",
 261      tif => "tiff",
 262      TIFF => "tiff",
 263      JPG => "jpeg",
 264      rle => "utah",
 265      bmp => "bmp",
 266      dib => "bmp",
 267      rgb => "sgi",
 268      BW => "sgi",
 269      TGA => "tga",
 270      CUR => "cur",
 271      ico => "ico",
 272      ILBM => "ilbm",
 273      pcx => "pcx",
 274      psd => "psd",
 275     );
 276
 277   while (my ($ext, $expect) = splice(@tests, 0, 2)) {
 278     my $filename = "foo.$ext";
 279     is(Imager::def_guess_type($filename), $expect,
 280        "type for $filename should be $expect");
 281   }
 282 }
 283
 284 Imager->close_log;
 285
 286 unless ($ENV{IMAGER_KEEP_FILES}) {
 287   unlink "testout/t1000files.log";
 288 }
 289
 290 sub probe_ok {
 291   my ($packed, $exp_type, $name) = @_;
 292
 293   my $builder = Test::Builder->new;
 294   $packed =~ tr/ \r\n//d; # remove whitespace used for layout
 295   my $data = pack("H*", $packed);
 296
 297   my $io = Imager::io_new_buffer($data);
 298   my $result = Imager::i_test_format_probe($io, -1);
 299
 300   return $builder->is_eq($result, $exp_type, $name)
 301 }