t/t107bmp.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 89;
   5 use Imager qw(:all);
   6 init_log("testout/t107bmp.log",1);
   7 #BEGIN { require 't/testtools.pl'; } # BEGIN to apply prototypes
   8
   9 my $base_diff = 0;
  10 # if you change this make sure you generate new compressed versions
  11 my $green=i_color_new(0,255,0,255);
  12 my $blue=i_color_new(0,0,255,255);
  13 my $red=i_color_new(255,0,0,255);
  14
  15 my $img=Imager::ImgRaw::new(150,150,3);
  16
  17 i_box_filled($img,70,25,130,125,$green);
  18 i_box_filled($img,20,25,80,125,$blue);
  19 i_arc($img,75,75,30,0,361,$red);
  20 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  21
  22 Imager::i_tags_add($img, 'i_xres', 0, '300', 0);
  23 Imager::i_tags_add($img, 'i_yres', 0, undef, 300);
  24 write_test($img, "testout/t107_24bit.bmp");
  25 # 'webmap' is noticably faster than the default
  26 my $im8 = Imager::i_img_to_pal($img, { make_colors=>'webmap',
  27                                        translate=>'errdiff'});
  28 write_test($im8, "testout/t107_8bit.bmp");
  29 # use a fixed palette so we get reproducible results for the compressed
  30 # version
  31 my @pal16 = map { NC($_) }
  32   qw(605844 966600 0148b2 00f800 bf0a33 5e009e
  33      2ead1b 0000f8 004b01 fd0000 0e1695 000002);
  34 my $im4 = Imager::i_img_to_pal($img, { colors=>\@pal16, make_colors=>'none' });
  35 write_test($im4, "testout/t107_4bit.bmp");
  36 my $im1 = Imager::i_img_to_pal($img, { colors=>[ NC(0, 0, 0), NC(176, 160, 144) ],
  37                                make_colors=>'none', translate=>'errdiff' });
  38 write_test($im1, "testout/t107_1bit.bmp");
  39 my $bi_rgb = 0;
  40 my $bi_rle8 = 1;
  41 my $bi_rle4 = 2;
  42 my $bi_bitfields = 3;
  43 read_test("testout/t107_24bit.bmp", $img,
  44           bmp_compression=>0, bmp_bit_count => 24);
  45 read_test("testout/t107_8bit.bmp", $im8,
  46           bmp_compression=>0, bmp_bit_count => 8);
  47 read_test("testout/t107_4bit.bmp", $im4,
  48           bmp_compression=>0, bmp_bit_count => 4);
  49 read_test("testout/t107_1bit.bmp", $im1, bmp_compression=>0,
  50           bmp_bit_count=>1);
  51 # the following might have slight differences
  52 $base_diff = i_img_diff($img, $im8) * 2;
  53 print "# base difference $base_diff\n";
  54 read_test("testimg/comp4.bmp", $im4,
  55           bmp_compression=>$bi_rle4, bmp_bit_count => 4);
  56 read_test("testimg/comp8.bmp", $im8,
  57           bmp_compression=>$bi_rle8, bmp_bit_count => 8);
  58
  59 my $imoo = Imager->new;
  60 # read via OO
  61 ok($imoo->read(file=>'testout/t107_24bit.bmp'), "read via OO")
  62   or print "# ",$imoo->errstr,"\n";
  63
  64 ok($imoo->write(file=>'testout/t107_oo.bmp'), "write via OO")
  65   or print "# ",$imoo->errstr,"\n";
  66
  67 # various invalid format tests
  68 # we have so many different test images to try to detect all the possible
  69 # failure paths in the code, adding these did detect real problems
  70 print "# catch various types of invalid bmp files\n";
  71 my @tests =
  72   (
  73    # entries in each array ref are:
  74    #  - basename of an invalid BMP file
  75    #  - error message that should be produced
  76    #  - description of what is being tested
  77    #  - possible flag to indicate testing only on 32-bit machines
  78    [ 'badplanes.bmp', 'not a BMP file', "invalid planes value" ],
  79    [ 'badbits.bmp', 'unknown bit count for BMP file (5)',
  80      'should fail to read invalid bits' ],
  81
  82    # 1-bit/pixel BMPs
  83    [ 'badused1.bmp', 'out of range colors used (3)',
  84      'out of range palette size (1-bit)' ],
  85    [ 'badcomp1.bmp', 'unknown 1-bit BMP compression (1)',
  86      'invalid compression value (1-bit)' ],
  87    [ 'bad1wid0.bmp', 'file size limit - image width of 0 is not positive',
  88      'width 0 (1-bit)' ],
  89    [ 'bad4oflow.bmp',
  90      'file size limit - integer overflow calculating storage',
  91      'overflow integers on 32-bit machines (1-bit)', '32bitonly' ],
  92    [ 'short1.bmp', 'failed reading 1-bit bmp data',
  93      'short 1-bit' ],
  94
  95    # 4-bit/pixel BMPs
  96    [ 'badused4a.bmp', 'out of range colors used (272)',
  97      'should fail to read invalid pal size (272) (4-bit)' ],
  98    [ 'badused4b.bmp', 'out of range colors used (17)',
  99      'should fail to read invalid pal size (17) (4-bit)' ],
 100    [ 'badcomp4.bmp', 'unknown 4-bit BMP compression (1)',
 101      'invalid compression value (4-bit)' ],
 102    [ 'short4.bmp', 'failed reading 4-bit bmp data',
 103      'short uncompressed 4-bit' ],
 104    [ 'short4rle.bmp', 'missing data during decompression',
 105      'short compressed 4-bit' ],
 106    [ 'bad4wid0.bmp', 'file size limit - image width of 0 is not positive',
 107      'width 0 (4-bit)' ],
 108    [ 'bad4widbig.bmp', 'file size limit - image width of -2147483628 is not positive',
 109      'width big (4-bit)' ],
 110    [ 'bad4oflow.bmp', 'file size limit - integer overflow calculating storage',
 111      'overflow integers on 32-bit machines (4-bit)', '32bitonly' ],
 112
 113    # 8-bit/pixel BMPs
 114    [ 'bad8useda.bmp', 'out of range colors used (257)',
 115      'should fail to read invalid pal size (8-bit)' ],
 116    [ 'bad8comp.bmp', 'unknown 8-bit BMP compression (2)',
 117      'invalid compression value (8-bit)' ],
 118    [ 'short8.bmp', 'failed reading 8-bit bmp data',
 119      'short uncompressed 8-bit' ],
 120    [ 'short8rle.bmp', 'missing data during decompression',
 121      'short compressed 8-bit' ],
 122    [ 'bad8wid0.bmp', 'file size limit - image width of 0 is not positive',
 123      'width 0 (8-bit)' ],
 124    [ 'bad8oflow.bmp', 'file size limit - integer overflow calculating storage',
 125      'overflow integers on 32-bit machines (8-bit)', '32bitonly' ],
 126
 127    # 24-bit/pixel BMPs
 128    [ 'short24.bmp', 'failed reading image data',
 129      'short 24-bit' ],
 130    [ 'bad24wid0.bmp', 'file size limit - image width of 0 is not positive',
 131      'width 0 (24-bit)' ],
 132    [ 'bad24oflow.bmp', 'file size limit - integer overflow calculating storage',
 133      'overflow integers on 32-bit machines (24-bit)', '32bitonly' ],
 134    [ 'bad24comp.bmp', 'unknown 24-bit BMP compression (4)',
 135      'bad compression (24-bit)' ],
 136   );
 137 use Config;
 138 my $intsize = $Config{intsize};
 139 for my $test (@tests) {
 140   my ($file, $error, $comment, $bit32only) = @$test;
 141  SKIP:
 142   {
 143     skip("only tested on 32-bit machines", 2)
 144       if $bit32only && $intsize != 4;
 145     ok(!$imoo->read(file=>"testimg/$file"), $comment);
 146     is($imoo->errstr, $error, "check error message");
 147   }
 148 }
 149
 150 # previously we didn't seek to the offbits position before reading
 151 # the image data, check we handle it correctly
 152 # in each case the first is an original image with a given number of
 153 # bits and the second is the same file with data inserted before the
 154 # image bits and the offset modified to suit
 155 my @comp =
 156   (
 157    [ 'winrgb2.bmp', 'winrgb2off.bmp', 1 ],
 158    [ 'winrgb4.bmp', 'winrgb4off.bmp', 4 ],
 159    [ 'winrgb8.bmp', 'winrgb8off.bmp', 8 ],
 160    [ 'winrgb24.bmp', 'winrgb24off.bmp', 24 ],
 161   );
 162
 163 for my $comp (@comp) {
 164   my ($base_file, $off_file, $bits) = @$comp;
 165
 166   my $base_im = Imager->new;
 167   my $got_base =
 168     ok($base_im->read(file=>"testimg/$base_file"),
 169         "read original")
 170       or print "# ",$base_im->errstr,"\n";
 171   my $off_im = Imager->new;
 172   my $got_off =
 173     ok($off_im->read(file=>"testimg/$off_file"),
 174         "read offset file")
 175       or print "# ",$off_im->errstr,"\n";
 176  SKIP:
 177   {
 178     skip("missed one file", 1)
 179       unless $got_base && $got_off;
 180     is(i_img_diff($base_im->{IMG}, $off_im->{IMG}), 0,
 181         "compare base and offset image ($bits bits)");
 182   }
 183 }
 184
 185 { # check file limits are checked
 186   my $limit_file = "testout/t104.ppm";
 187   ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
 188   my $im = Imager->new;
 189   ok(!$im->read(file=>$limit_file),
 190      "should fail read due to size limits");
 191   print "# ",$im->errstr,"\n";
 192   like($im->errstr, qr/image width/, "check message");
 193
 194   ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
 195   ok(!$im->read(file=>$limit_file),
 196      "should fail read due to size limits");
 197   print "# ",$im->errstr,"\n";
 198   like($im->errstr, qr/image height/, "check message");
 199
 200   ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
 201   ok($im->read(file=>$limit_file),
 202      "should succeed - just inside width limit");
 203   ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
 204   ok($im->read(file=>$limit_file),
 205      "should succeed - just inside height limit");
 206
 207   # 150 x 150 x 3 channel image uses 67500 bytes
 208   ok(Imager->set_file_limits(reset=>1, bytes=>67499),
 209      "set bytes limit 67499");
 210   ok(!$im->read(file=>$limit_file),
 211      "should fail - too many bytes");
 212   print "# ",$im->errstr,"\n";
 213   like($im->errstr, qr/storage size/, "check error message");
 214   ok(Imager->set_file_limits(reset=>1, bytes=>67500),
 215      "set bytes limit 67500");
 216   ok($im->read(file=>$limit_file),
 217      "should succeed - just inside bytes limit");
 218   Imager->set_file_limits(reset=>1);
 219 }
 220
 221 sub write_test {
 222   my ($im, $filename) = @_;
 223   local *FH;
 224
 225   if (open FH, "> $filename") {
 226     binmode FH;
 227     my $IO = Imager::io_new_fd(fileno(FH));
 228     unless (ok(Imager::i_writebmp_wiol($im, $IO), $filename)) {
 229       print "# ",Imager->_error_as_msg(),"\n";
 230     }
 231     undef $IO;
 232     close FH;
 233   }
 234   else {
 235     fail("could not open $filename: $!");
 236   }
 237 }
 238
 239 sub read_test {
 240   my ($filename, $im, %tags) = @_;
 241   local *FH;
 242
 243   print "# read_test: $filename\n";
 244
 245   $tags{i_format} = "bmp";
 246
 247   if (open FH, "< $filename") {
 248     binmode FH;
 249     my $IO = Imager::io_new_fd(fileno(FH));
 250     my $im_read = Imager::i_readbmp_wiol($IO);
 251     if ($im_read) {
 252       my $diff = i_img_diff($im, $im_read);
 253       if ($diff > $base_diff) {
 254         fail("image mismatch reading $filename");
 255       }
 256       else {
 257         my $tags_ok = 1;
 258         for my $tag (keys %tags) {
 259           if (my $index = Imager::i_tags_find($im_read, $tag, 0)) {
 260             my ($name, $value) = Imager::i_tags_get($im_read, $index);
 261             my $exp_value = $tags{$tag};
 262             print "#   tag $name = '$value' - expect '$exp_value'\n";
 263             if ($exp_value =~ /\d/) {
 264               if ($value != $tags{$tag}) {
 265                 print "# tag $tag value mismatch $tags{$tag} != $value\n";
 266                 $tags_ok = 0;
 267               }
 268             }
 269             else {
 270               if ($value ne $tags{$tag}) {
 271                 print "# tag $tag value mismatch $tags{$tag} != $value\n";
 272                 $tags_ok = 0;
 273               }
 274             }
 275           }
 276         }
 277         ok($tags_ok, "reading $filename");
 278         #  for my $i (0 .. Imager::i_tags_count($im_read)-1) {
 279         #    my ($name, $value) = Imager::i_tags_get($im_read, $i);
 280         #    print "# tag '$name' => '$value'\n";
 281         #}
 282       }
 283     }
 284     else {
 285       fail("could not read $filename: ".Imager->_error_as_msg());
 286     }
 287     undef $IO;
 288     close FH;
 289   }
 290   else {
 291     fail("could not open $filename: $!");
 292   }
 293 }
 294