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', 0777;
   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 }