t/t107bmp.t

   1 #!perl -w
   2 print "1..62\n";
   3 use Imager qw(:all);
   4 use strict;
   5 init_log("testout/t107bmp.log",1);
   6 require 't/testtools.pl';
   7
   8 my $base_diff = 0;
   9 # if you change this make sure you generate new compressed versions
  10 my $green=i_color_new(0,255,0,255);
  11 my $blue=i_color_new(0,0,255,255);
  12 my $red=i_color_new(255,0,0,255);
  13
  14 my $img=Imager::ImgRaw::new(150,150,3);
  15
  16 i_box_filled($img,70,25,130,125,$green);
  17 i_box_filled($img,20,25,80,125,$blue);
  18 i_arc($img,75,75,30,0,361,$red);
  19 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  20
  21 Imager::i_tags_add($img, 'i_xres', 0, '300', 0);
  22 Imager::i_tags_add($img, 'i_yres', 0, undef, 300);
  23 write_test(1, $img, "testout/t107_24bit.bmp");
  24 # 'webmap' is noticably faster than the default
  25 my $im8 = Imager::i_img_to_pal($img, { make_colors=>'webmap',
  26                                        translate=>'errdiff'});
  27 write_test(2, $im8, "testout/t107_8bit.bmp");
  28 # use a fixed palette so we get reproducible results for the compressed
  29 # version
  30 my @pal16 = map { NC($_) }
  31   qw(605844 966600 0148b2 00f800 bf0a33 5e009e
  32      2ead1b 0000f8 004b01 fd0000 0e1695 000002);
  33 my $im4 = Imager::i_img_to_pal($img, { colors=>\@pal16, make_colors=>'none' });
  34 write_test(3, $im4, "testout/t107_4bit.bmp");
  35 my $im1 = Imager::i_img_to_pal($img, { colors=>[ NC(0, 0, 0), NC(176, 160, 144) ],
  36                                make_colors=>'none', translate=>'errdiff' });
  37 write_test(4, $im1, "testout/t107_1bit.bmp");
  38 my $bi_rgb = 0;
  39 my $bi_rle8 = 1;
  40 my $bi_rle4 = 2;
  41 my $bi_bitfields = 3;
  42 read_test(5, "testout/t107_24bit.bmp", $img,
  43           bmp_compression=>0, bmp_bit_count => 24);
  44 read_test(6, "testout/t107_8bit.bmp", $im8,
  45           bmp_compression=>0, bmp_bit_count => 8);
  46 read_test(7, "testout/t107_4bit.bmp", $im4,
  47           bmp_compression=>0, bmp_bit_count => 4);
  48 read_test(8, "testout/t107_1bit.bmp", $im1, bmp_compression=>0,
  49           bmp_bit_count=>1);
  50 # the following might have slight differences
  51 $base_diff = i_img_diff($img, $im8) * 2;
  52 print "# base difference $base_diff\n";
  53 read_test(9, "testimg/comp4.bmp", $im4,
  54           bmp_compression=>$bi_rle4, bmp_bit_count => 4);
  55 read_test(10, "testimg/comp8.bmp", $im8,
  56           bmp_compression=>$bi_rle8, bmp_bit_count => 8);
  57
  58 my $imoo = Imager->new;
  59 if ($imoo->read(file=>'testout/t107_24bit.bmp')) {
  60   print "ok 11\n";
  61 }
  62 else {
  63   print "not ok 11 # ",$imoo->errstr,"\n";
  64 }
  65 if ($imoo->write(file=>'testout/t107_oo.bmp')) {
  66   print "ok 12\n";
  67 }
  68 else {
  69   print "not 12 # ",$imoo->errstr,"\n";
  70 }
  71
  72 # various invalid format tests
  73 # we have so many different test images to try to detect all the possible
  74 # failure paths in the code, adding these did detect real problems
  75 print "# catch various types of invalid bmp files\n";
  76 my $test_num = 13;
  77 my @tests =
  78   (
  79    # entries in each array ref are:
  80    #  - basename of an invalid BMP file
  81    #  - error message that should be produced
  82    #  - description of what is being tested
  83    #  - possible flag to indicate testing only on 32-bit machines
  84    [ 'badplanes.bmp', 'not a BMP file', "invalid planes value" ],
  85    [ 'badbits.bmp', 'unknown bit count for BMP file (5)',
  86      'should fail to read invalid bits' ],
  87
  88    # 1-bit/pixel BMPs
  89    [ 'badused1.bmp', 'out of range colors used (3)',
  90      'out of range palette size (1-bit)' ],
  91    [ 'badcomp1.bmp', 'unknown 1-bit BMP compression (1)',
  92      'invalid compression value (1-bit)' ],
  93    [ 'bad1wid0.bmp', 'Image sizes must be positive',
  94      'width 0 (1-bit)' ],
  95    [ 'bad4oflow.bmp', 'integer overflow calculating image allocation',
  96      'overflow integers on 32-bit machines (1-bit)', '32bitonly' ],
  97    [ 'short1.bmp', 'failed reading 1-bit bmp data',
  98      'short 1-bit' ],
  99
 100    # 4-bit/pixel BMPs
 101    [ 'badused4a.bmp', 'out of range colors used (272)',
 102      'should fail to read invalid pal size (272) (4-bit)' ],
 103    [ 'badused4b.bmp', 'out of range colors used (17)',
 104      'should fail to read invalid pal size (17) (4-bit)' ],
 105    [ 'badcomp4.bmp', 'unknown 4-bit BMP compression (1)',
 106      'invalid compression value (4-bit)' ],
 107    [ 'short4.bmp', 'failed reading 4-bit bmp data',
 108      'short uncompressed 4-bit' ],
 109    [ 'short4rle.bmp', 'missing data during decompression',
 110      'short compressed 4-bit' ],
 111    [ 'bad4wid0.bmp', 'Image sizes must be positive',
 112      'width 0 (4-bit)' ],
 113    [ 'bad4widbig.bmp', 'Image sizes must be positive',
 114      'width big (4-bit)' ],
 115    [ 'bad4oflow.bmp', 'integer overflow calculating image allocation',
 116      'overflow integers on 32-bit machines (4-bit)', '32bitonly' ],
 117
 118    # 8-bit/pixel BMPs
 119    [ 'bad8useda.bmp', 'out of range colors used (257)',
 120      'should fail to read invalid pal size (8-bit)' ],
 121    [ 'bad8comp.bmp', 'unknown 8-bit BMP compression (2)',
 122      'invalid compression value (8-bit)' ],
 123    [ 'short8.bmp', 'failed reading 8-bit bmp data',
 124      'short uncompressed 8-bit' ],
 125    [ 'short8rle.bmp', 'missing data during decompression',
 126      'short compressed 8-bit' ],
 127    [ 'bad8wid0.bmp', 'Image sizes must be positive',
 128      'width 0 (8-bit)' ],
 129    [ 'bad8oflow.bmp', 'integer overflow calculating image allocation',
 130      'overflow integers on 32-bit machines (8-bit)', '32bitonly' ],
 131
 132    # 24-bit/pixel BMPs
 133    [ 'short24.bmp', 'failed reading image data',
 134      'short 24-bit' ],
 135    [ 'bad24wid0.bmp', 'Image sizes must be positive',
 136      'width 0 (24-bit)' ],
 137    [ 'bad24oflow.bmp', 'integer overflow calculating image allocation',
 138      'overflow integers on 32-bit machines (24-bit)', '32bitonly' ],
 139    [ 'bad24comp.bmp', 'unknown 24-bit BMP compression (4)',
 140      'bad compression (24-bit)' ],
 141   );
 142 use Config;
 143 my $intsize = $Config{intsize};
 144 for my $test (@tests) {
 145   my ($file, $error, $comment, $bit32only) = @$test;
 146   if (!$bit32only || $intsize == 4) {
 147     okn($test_num++, !$imoo->read(file=>"testimg/$file"), $comment);
 148     isn($test_num++, $imoo->errstr, $error, "check error message");
 149   }
 150   else {
 151     skipn($test_num, 2, "only tested on 32-bit machines");
 152     $test_num += 2;
 153   }
 154 }
 155
 156 sub write_test {
 157   my ($test_num, $im, $filename) = @_;
 158   local *FH;
 159
 160   if (open FH, "> $filename") {
 161     binmode FH;
 162     my $IO = Imager::io_new_fd(fileno(FH));
 163     if (Imager::i_writebmp_wiol($im, $IO)) {
 164       print "ok $test_num\n";
 165     }
 166     else {
 167       print "not ok $test_num # ",Imager->_error_as_msg(),"\n";
 168     }
 169     undef $IO;
 170     close FH;
 171   }
 172   else {
 173     print "not ok $test_num # $!\n";
 174   }
 175 }
 176
 177 sub read_test {
 178   my ($test_num, $filename, $im, %tags) = @_;
 179   local *FH;
 180
 181   print "# read_test: $filename\n";
 182
 183   $tags{i_format} = "bmp";
 184
 185   if (open FH, "< $filename") {
 186     binmode FH;
 187     my $IO = Imager::io_new_fd(fileno(FH));
 188     my $im_read = Imager::i_readbmp_wiol($IO);
 189     if ($im_read) {
 190       my $diff = i_img_diff($im, $im_read);
 191       if ($diff > $base_diff) {
 192         print "not ok $test_num # image mismatch $diff\n";
 193       }
 194       else {
 195         my $tags_ok = 1;
 196         for my $tag (keys %tags) {
 197           if (my $index = Imager::i_tags_find($im_read, $tag, 0)) {
 198             my ($name, $value) = Imager::i_tags_get($im_read, $index);
 199             my $exp_value = $tags{$tag};
 200             print "#   tag $name = '$value' - expect '$exp_value'\n";
 201             if ($exp_value =~ /\d/) {
 202               if ($value != $tags{$tag}) {
 203                 print "# tag $tag value mismatch $tags{$tag} != $value\n";
 204                 $tags_ok = 0;
 205               }
 206             }
 207             else {
 208               if ($value ne $tags{$tag}) {
 209                 print "# tag $tag value mismatch $tags{$tag} != $value\n";
 210                 $tags_ok = 0;
 211               }
 212             }
 213           }
 214         }
 215         if ($tags_ok) {
 216           print "ok $test_num\n";
 217         }
 218         else {
 219           print "not ok $test_num # bad tag values\n";
 220         }
 221         #  for my $i (0 .. Imager::i_tags_count($im_read)-1) {
 222         #    my ($name, $value) = Imager::i_tags_get($im_read, $i);
 223         #    print "# tag '$name' => '$value'\n";
 224         #}
 225       }
 226     }
 227     else {
 228       print "not ok $test_num # ",Imager->_error_as_msg(),"\n";
 229     }
 230     undef $IO;
 231     close FH;
 232   }
 233   else {
 234     print "not ok $test_num # $!\n";
 235   }
 236 }
 237