- the BMP reader now validates the bfOffBits value from the BMP header
[imager.git] / t / t107bmp.t
CommitLineData
261f91c5 1#!perl -w
403946c6 2print "1..74\n";
261f91c5
TC
3use Imager qw(:all);
4use strict;
5init_log("testout/t107bmp.log",1);
403946c6 6BEGIN { require 't/testtools.pl'; } # BEGIN to apply prototypes
261f91c5 7
705fd961
TC
8my $base_diff = 0;
9# if you change this make sure you generate new compressed versions
261f91c5
TC
10my $green=i_color_new(0,255,0,255);
11my $blue=i_color_new(0,0,255,255);
12my $red=i_color_new(255,0,0,255);
13
14my $img=Imager::ImgRaw::new(150,150,3);
261f91c5
TC
15
16i_box_filled($img,70,25,130,125,$green);
17i_box_filled($img,20,25,80,125,$blue);
18i_arc($img,75,75,30,0,361,$red);
19i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
20
705fd961
TC
21Imager::i_tags_add($img, 'i_xres', 0, '300', 0);
22Imager::i_tags_add($img, 'i_yres', 0, undef, 300);
261f91c5
TC
23write_test(1, $img, "testout/t107_24bit.bmp");
24# 'webmap' is noticably faster than the default
25my $im8 = Imager::i_img_to_pal($img, { make_colors=>'webmap',
26 translate=>'errdiff'});
27write_test(2, $im8, "testout/t107_8bit.bmp");
705fd961
TC
28# use a fixed palette so we get reproducible results for the compressed
29# version
30my @pal16 = map { NC($_) }
31 qw(605844 966600 0148b2 00f800 bf0a33 5e009e
32 2ead1b 0000f8 004b01 fd0000 0e1695 000002);
33my $im4 = Imager::i_img_to_pal($img, { colors=>\@pal16, make_colors=>'none' });
261f91c5
TC
34write_test(3, $im4, "testout/t107_4bit.bmp");
35my $im1 = Imager::i_img_to_pal($img, { colors=>[ NC(0, 0, 0), NC(176, 160, 144) ],
36 make_colors=>'none', translate=>'errdiff' });
37write_test(4, $im1, "testout/t107_1bit.bmp");
705fd961
TC
38my $bi_rgb = 0;
39my $bi_rle8 = 1;
40my $bi_rle4 = 2;
41my $bi_bitfields = 3;
662e3c02
TC
42read_test(5, "testout/t107_24bit.bmp", $img,
43 bmp_compression=>0, bmp_bit_count => 24);
44read_test(6, "testout/t107_8bit.bmp", $im8,
45 bmp_compression=>0, bmp_bit_count => 8);
46read_test(7, "testout/t107_4bit.bmp", $im4,
47 bmp_compression=>0, bmp_bit_count => 4);
48read_test(8, "testout/t107_1bit.bmp", $im1, bmp_compression=>0,
49 bmp_bit_count=>1);
705fd961
TC
50# the following might have slight differences
51$base_diff = i_img_diff($img, $im8) * 2;
52print "# base difference $base_diff\n";
662e3c02
TC
53read_test(9, "testimg/comp4.bmp", $im4,
54 bmp_compression=>$bi_rle4, bmp_bit_count => 4);
55read_test(10, "testimg/comp8.bmp", $im8,
56 bmp_compression=>$bi_rle8, bmp_bit_count => 8);
705fd961
TC
57
58my $imoo = Imager->new;
59if ($imoo->read(file=>'testout/t107_24bit.bmp')) {
60 print "ok 11\n";
61}
62else {
63 print "not ok 11 # ",$imoo->errstr,"\n";
64}
65if ($imoo->write(file=>'testout/t107_oo.bmp')) {
66 print "ok 12\n";
67}
68else {
69 print "not 12 # ",$imoo->errstr,"\n";
70}
261f91c5 71
662e3c02
TC
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
75print "# catch various types of invalid bmp files\n";
76my $test_num = 13;
77my @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 );
142use Config;
143my $intsize = $Config{intsize};
144for 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}
403946c6
TC
155
156# previously we didn't seek to the offbits position before reading
157# the image data, check we handle it correctly
158# in each case the first is an original image with a given number of
159# bits and the second is the same file with data inserted before the
160# image bits and the offset modified to suit
161my @comp =
162 (
163 [ 'winrgb2.bmp', 'winrgb2off.bmp', 1 ],
164 [ 'winrgb4.bmp', 'winrgb4off.bmp', 4 ],
165 [ 'winrgb8.bmp', 'winrgb8off.bmp', 8 ],
166 [ 'winrgb24.bmp', 'winrgb24off.bmp', 24 ],
167 );
168
169for my $comp (@comp) {
170 my ($base_file, $off_file, $bits) = @$comp;
171
172 my $base_im = Imager->new;
173 my $got_base =
174 okn($test_num++, $base_im->read(file=>"testimg/$base_file"),
175 "read original")
176 or print "# ",$base_im->errstr,"\n";
177 my $off_im = Imager->new;
178 my $got_off =
179 okn($test_num++, $off_im->read(file=>"testimg/$off_file"),
180 "read offset file")
181 or print "# ",$off_im->errstr,"\n";
182 if ($got_base && $got_off) {
183 okn($test_num++, !i_img_diff($base_im->{IMG}, $off_im->{IMG}),
184 "compare base and offset image ($bits bits)");
185 }
186 else {
187 skipn($test_num++, 1, "missed one file");
188 }
189}
662e3c02 190
261f91c5
TC
191sub write_test {
192 my ($test_num, $im, $filename) = @_;
193 local *FH;
194
195 if (open FH, "> $filename") {
196 binmode FH;
197 my $IO = Imager::io_new_fd(fileno(FH));
198 if (Imager::i_writebmp_wiol($im, $IO)) {
199 print "ok $test_num\n";
200 }
201 else {
202 print "not ok $test_num # ",Imager->_error_as_msg(),"\n";
203 }
204 undef $IO;
205 close FH;
206 }
207 else {
208 print "not ok $test_num # $!\n";
209 }
210}
705fd961
TC
211
212sub read_test {
213 my ($test_num, $filename, $im, %tags) = @_;
214 local *FH;
662e3c02
TC
215
216 print "# read_test: $filename\n";
217
218 $tags{i_format} = "bmp";
705fd961
TC
219
220 if (open FH, "< $filename") {
221 binmode FH;
222 my $IO = Imager::io_new_fd(fileno(FH));
223 my $im_read = Imager::i_readbmp_wiol($IO);
224 if ($im_read) {
225 my $diff = i_img_diff($im, $im_read);
226 if ($diff > $base_diff) {
227 print "not ok $test_num # image mismatch $diff\n";
228 }
229 else {
230 my $tags_ok = 1;
231 for my $tag (keys %tags) {
232 if (my $index = Imager::i_tags_find($im_read, $tag, 0)) {
233 my ($name, $value) = Imager::i_tags_get($im_read, $index);
662e3c02
TC
234 my $exp_value = $tags{$tag};
235 print "# tag $name = '$value' - expect '$exp_value'\n";
236 if ($exp_value =~ /\d/) {
237 if ($value != $tags{$tag}) {
238 print "# tag $tag value mismatch $tags{$tag} != $value\n";
239 $tags_ok = 0;
240 }
241 }
242 else {
243 if ($value ne $tags{$tag}) {
244 print "# tag $tag value mismatch $tags{$tag} != $value\n";
245 $tags_ok = 0;
246 }
705fd961
TC
247 }
248 }
249 }
250 if ($tags_ok) {
251 print "ok $test_num\n";
252 }
253 else {
254 print "not ok $test_num # bad tag values\n";
255 }
256 # for my $i (0 .. Imager::i_tags_count($im_read)-1) {
257 # my ($name, $value) = Imager::i_tags_get($im_read, $i);
258 # print "# tag '$name' => '$value'\n";
259 #}
260 }
261 }
262 else {
263 print "not ok $test_num # ",Imager->_error_as_msg(),"\n";
264 }
265 undef $IO;
266 close FH;
267 }
268 else {
269 print "not ok $test_num # $!\n";
270 }
271}
272