]>
Commit | Line | Data |
---|---|---|
2ce44e2a TC |
1 | #!perl -w |
2 | use strict; | |
7d582d0f | 3 | use Test::More tests => 136; |
5c5abac4 | 4 | BEGIN { use_ok(Imager => qw(:all :handy)) } |
1501d9b3 | 5 | |
7d582d0f | 6 | use Imager::Test qw(test_image is_image is_color3); |
bfe6ba3f | 7 | |
40e78f96 TC |
8 | -d "testout" or mkdir "testout"; |
9 | ||
cc59eadc | 10 | Imager->open_log(log => "testout/t022double.log"); |
2ce44e2a | 11 | |
8927ff88 | 12 | use Imager::Test qw(image_bounds_checks test_colorf_gpix test_colorf_glin mask_tests); |
837a4b43 | 13 | |
2ce44e2a TC |
14 | use Imager::Color::Float; |
15 | ||
16 | my $im_g = Imager::i_img_double_new(100, 101, 1); | |
17 | ||
5c5abac4 | 18 | ok(Imager::i_img_getchannels($im_g) == 1, |
2ce44e2a | 19 | "1 channel image channel count mismatch"); |
5c5abac4 TC |
20 | ok(Imager::i_img_getmask($im_g) & 1, "1 channel image bad mask"); |
21 | ok(Imager::i_img_virtual($im_g) == 0, | |
2ce44e2a TC |
22 | "1 channel image thinks it is virtual"); |
23 | my $double_bits = length(pack("d", 1)) * 8; | |
af3c2450 | 24 | print "# $double_bits double bits\n"; |
5c5abac4 | 25 | ok(Imager::i_img_bits($im_g) == $double_bits, |
2ce44e2a | 26 | "1 channel image has bits != $double_bits"); |
5c5abac4 | 27 | ok(Imager::i_img_type($im_g) == 0, "1 channel image isn't direct"); |
2ce44e2a TC |
28 | |
29 | my @ginfo = i_img_info($im_g); | |
5c5abac4 TC |
30 | ok($ginfo[0] == 100, "1 channel image width incorrect"); |
31 | ok($ginfo[1] == 101, "1 channel image height incorrect"); | |
2ce44e2a TC |
32 | |
33 | undef $im_g; | |
34 | ||
35 | my $im_rgb = Imager::i_img_double_new(100, 101, 3); | |
36 | ||
5c5abac4 | 37 | ok(Imager::i_img_getchannels($im_rgb) == 3, |
2ce44e2a | 38 | "3 channel image channel count mismatch"); |
5c5abac4 TC |
39 | ok((Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image bad mask"); |
40 | ok(Imager::i_img_bits($im_rgb) == $double_bits, | |
2ce44e2a | 41 | "3 channel image has bits != $double_bits"); |
5c5abac4 | 42 | ok(Imager::i_img_type($im_rgb) == 0, "3 channel image isn't direct"); |
2ce44e2a TC |
43 | |
44 | my $redf = NCF(1, 0, 0); | |
45 | my $greenf = NCF(0, 1, 0); | |
46 | my $bluef = NCF(0, 0, 1); | |
47 | ||
48 | # fill with red | |
49 | for my $y (0..101) { | |
50 | Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100); | |
51 | } | |
5c5abac4 | 52 | |
2ce44e2a | 53 | # basic sanity |
5c5abac4 TC |
54 | test_colorf_gpix($im_rgb, 0, 0, $redf); |
55 | test_colorf_gpix($im_rgb, 99, 0, $redf); | |
56 | test_colorf_gpix($im_rgb, 0, 100, $redf); | |
57 | test_colorf_gpix($im_rgb, 99, 100, $redf); | |
8927ff88 TC |
58 | test_colorf_glin($im_rgb, 0, 0, [ ($redf) x 100 ], 'sanity glin @0'); |
59 | test_colorf_glin($im_rgb, 0, 100, [ ($redf) x 100 ], 'sanity glin @100'); | |
2ce44e2a TC |
60 | |
61 | Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60); | |
5c5abac4 | 62 | test_colorf_glin($im_rgb, 0, 1, |
8927ff88 TC |
63 | [ ($redf) x 20, ($greenf) x 60, ($redf) x 20 ], |
64 | 'check after write'); | |
2ce44e2a TC |
65 | |
66 | # basic OO tests | |
af3c2450 | 67 | my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double'); |
5c5abac4 | 68 | ok($ooimg, "couldn't make double image"); |
5386861e | 69 | is($ooimg->bits, 'double', "oo didn't give double image"); |
bd8052a6 | 70 | ok(!$ooimg->is_bilevel, 'not monochrome'); |
2ce44e2a | 71 | |
af3c2450 TC |
72 | # check that the image is copied correctly |
73 | my $oocopy = $ooimg->copy; | |
92bda632 | 74 | is($oocopy->bits, 'double', "oo copy didn't give double image"); |
2ce44e2a | 75 | |
5c5abac4 | 76 | ok(!Imager->new(xsize=>0, ysize=>1, bits=>'double'), |
1501d9b3 | 77 | "fail making 0 width image"); |
5c5abac4 | 78 | cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/, |
1501d9b3 | 79 | "and correct message"); |
5c5abac4 | 80 | ok(!Imager->new(xsize=>1, ysize=>0, bits=>'double'), |
1501d9b3 | 81 | "fail making 0 height image"); |
5c5abac4 | 82 | cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/, |
1501d9b3 | 83 | "and correct message"); |
5c5abac4 | 84 | ok(!Imager->new(xsize=>-1, ysize=>1, bits=>'double'), |
1501d9b3 | 85 | "fail making -ve width image"); |
5c5abac4 | 86 | cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/, |
1501d9b3 | 87 | "and correct message"); |
5c5abac4 | 88 | ok(!Imager->new(xsize=>1, ysize=>-1, bits=>'double'), |
1501d9b3 | 89 | "fail making -ve height image"); |
5c5abac4 | 90 | cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/, |
1501d9b3 | 91 | "and correct message"); |
5c5abac4 | 92 | ok(!Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>0), |
1501d9b3 | 93 | "fail making 0 channel image"); |
5c5abac4 | 94 | cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/, |
1501d9b3 | 95 | "and correct message"); |
5c5abac4 | 96 | ok(!Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>5), |
1501d9b3 | 97 | "fail making 5 channel image"); |
5c5abac4 | 98 | cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/, |
1501d9b3 TC |
99 | "and correct message"); |
100 | ||
653ea321 TC |
101 | { |
102 | # https://rt.cpan.org/Ticket/Display.html?id=8213 | |
103 | # check for handling of memory allocation of very large images | |
104 | # only test this on 32-bit machines - on a 64-bit machine it may | |
105 | # result in trying to allocate 4Gb of memory, which is unfriendly at | |
106 | # least and may result in running out of memory, causing a different | |
107 | # type of exit | |
108 | use Config; | |
5c5abac4 TC |
109 | SKIP: |
110 | { | |
8d14daab | 111 | $Config{ptrsize} == 4 |
5c5abac4 | 112 | or skip "don't want to allocate 4Gb", 8; |
4afadaa0 | 113 | my $uint_range = 256 ** $Config{intsize}; |
653ea321 TC |
114 | my $dbl_size = $Config{doublesize} || 8; |
115 | my $dim1 = int(sqrt($uint_range/$dbl_size))+1; | |
116 | ||
117 | my $im_b = Imager->new(xsize=>$dim1, ysize=>$dim1, channels=>1, bits=>'double'); | |
5c5abac4 | 118 | is($im_b, undef, "integer overflow check - 1 channel"); |
653ea321 TC |
119 | |
120 | $im_b = Imager->new(xisze=>$dim1, ysize=>1, channels=>1, bits=>'double'); | |
5c5abac4 | 121 | ok($im_b, "but same width ok"); |
653ea321 | 122 | $im_b = Imager->new(xisze=>1, ysize=>$dim1, channels=>1, bits=>'double'); |
5c5abac4 TC |
123 | ok($im_b, "but same height ok"); |
124 | cmp_ok(Imager->errstr, '=~', qr/integer overflow/, | |
653ea321 TC |
125 | "check the error message"); |
126 | ||
127 | # do a similar test with a 3 channel image, so we're sure we catch | |
128 | # the same case where the third dimension causes the overflow | |
129 | my $dim3 = int(sqrt($uint_range / 3 / $dbl_size))+1; | |
130 | ||
131 | $im_b = Imager->new(xsize=>$dim3, ysize=>$dim3, channels=>3, bits=>'double'); | |
5c5abac4 | 132 | is($im_b, undef, "integer overflow check - 3 channel"); |
653ea321 | 133 | |
5c5abac4 TC |
134 | $im_b = Imager->new(xsize=>$dim3, ysize=>1, channels=>3, bits=>'double'); |
135 | ok($im_b, "but same width ok"); | |
136 | $im_b = Imager->new(xsize=>1, ysize=>$dim3, channels=>3, bits=>'double'); | |
137 | ok($im_b, "but same height ok"); | |
653ea321 | 138 | |
5c5abac4 | 139 | cmp_ok(Imager->errstr, '=~', qr/integer overflow/, |
653ea321 TC |
140 | "check the error message"); |
141 | } | |
653ea321 TC |
142 | } |
143 | ||
35f40526 | 144 | { # check the channel mask function |
35f40526 | 145 | |
35f40526 TC |
146 | my $im = Imager->new(xsize => 10, ysize=>10, bits=>'double'); |
147 | ||
9b8ce4f4 | 148 | mask_tests($im); |
35f40526 TC |
149 | } |
150 | ||
837a4b43 TC |
151 | { # bounds checking |
152 | my $im = Imager->new(xsize => 10, ysize=>10, bits=>'double'); | |
153 | image_bounds_checks($im); | |
154 | } | |
bfe6ba3f TC |
155 | |
156 | ||
157 | { # convert to rgb double | |
158 | my $im = test_image(); | |
159 | my $imdb = $im->to_rgb_double; | |
160 | print "# check conversion to double\n"; | |
161 | is($imdb->bits, "double", "check bits"); | |
162 | is_image($im, $imdb, "check image data matches"); | |
163 | } | |
164 | ||
165 | { # empty image handling | |
166 | my $im = Imager->new; | |
167 | ok($im, "make empty image"); | |
168 | ok(!$im->to_rgb_double, "convert empty image to double"); | |
169 | is($im->errstr, "empty input image", "check message"); | |
170 | } | |
cc59eadc | 171 | |
7d582d0f TC |
172 | my $psamp_outside_error = "Image position outside of image"; |
173 | { # psamp | |
174 | print "# psamp\n"; | |
175 | my $imraw = Imager::i_img_double_new(10, 10, 3); | |
176 | { | |
177 | is(Imager::i_psamp($imraw, 0, 2, undef, [ 255, 128, 64 ]), 3, | |
178 | "i_psamp def channels, 3 samples"); | |
179 | is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64, | |
180 | "check color written"); | |
181 | Imager::i_img_setmask($imraw, 5); | |
182 | is(Imager::i_psamp($imraw, 1, 3, undef, [ 64, 128, 192 ]), 3, | |
183 | "i_psamp def channels, 3 samples, masked"); | |
184 | is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 192, | |
185 | "check color written"); | |
186 | is(Imager::i_psamp($imraw, 1, 7, [ 0, 1, 2 ], [ 64, 128, 192 ]), 3, | |
187 | "i_psamp channels listed, 3 samples, masked"); | |
188 | is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 192, | |
189 | "check color written"); | |
190 | Imager::i_img_setmask($imraw, ~0); | |
191 | is(Imager::i_psamp($imraw, 2, 4, [ 0, 1 ], [ 255, 128, 64, 32 ]), 4, | |
192 | "i_psamp channels [0, 1], 4 samples"); | |
193 | is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0, | |
194 | "check first color written"); | |
195 | is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0, | |
196 | "check second color written"); | |
197 | is(Imager::i_psamp($imraw, 0, 5, [ 0, 1, 2 ], [ (128, 63, 32) x 10 ]), 30, | |
198 | "write a full row"); | |
199 | is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ], | |
200 | [ (128, 63, 32) x 10 ], | |
201 | "check full row"); | |
202 | is(Imager::i_psamp($imraw, 8, 8, [ 0, 1, 2 ], | |
203 | [ 255, 128, 32, 64, 32, 16, 32, 16, 8 ]), | |
204 | 6, "i_psamp channels [0, 1, 2], 9 samples, but room for 6"); | |
205 | } | |
206 | { # errors we catch | |
207 | is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, 3 ], [ 255, 128, 32 ]), | |
208 | undef, "i_psamp channels [0, 1, 3], 3 samples (invalid channel number)"); | |
209 | is(_get_error(), "No channel 3 in this image", | |
210 | "check error message"); | |
211 | is(Imager::i_psamp($imraw, 6, 8, [ 0, 1, -1 ], [ 255, 128, 32 ]), | |
212 | undef, "i_psamp channels [0, 1, -1], 3 samples (invalid channel number)"); | |
213 | is(_get_error(), "No channel -1 in this image", | |
214 | "check error message"); | |
215 | is(Imager::i_psamp($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef, | |
216 | "negative y"); | |
217 | is(_get_error(), $psamp_outside_error, "check error message"); | |
218 | is(Imager::i_psamp($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef, | |
219 | "y overflow"); | |
220 | is(_get_error(), $psamp_outside_error, "check error message"); | |
221 | is(Imager::i_psamp($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef, | |
222 | "negative x"); | |
223 | is(_get_error(), $psamp_outside_error, "check error message"); | |
224 | is(Imager::i_psamp($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef, | |
225 | "x overflow"); | |
226 | is(_get_error(), $psamp_outside_error, "check error message"); | |
227 | } | |
228 | print "# end psamp tests\n"; | |
229 | } | |
230 | ||
231 | { # psampf | |
232 | print "# psampf\n"; | |
233 | my $imraw = Imager::i_img_double_new(10, 10, 3); | |
234 | { | |
235 | is(Imager::i_psampf($imraw, 0, 2, undef, [ 1, 0.5, 0.25 ]), 3, | |
236 | "i_psampf def channels, 3 samples"); | |
29b38678 | 237 | is_color3(Imager::i_get_pixel($imraw, 0, 2), 255, 128, 64, |
7d582d0f TC |
238 | "check color written"); |
239 | Imager::i_img_setmask($imraw, 5); | |
240 | is(Imager::i_psampf($imraw, 1, 3, undef, [ 0.25, 0.5, 0.75 ]), 3, | |
241 | "i_psampf def channels, 3 samples, masked"); | |
29b38678 | 242 | is_color3(Imager::i_get_pixel($imraw, 1, 3), 64, 0, 191, |
7d582d0f TC |
243 | "check color written"); |
244 | is(Imager::i_psampf($imraw, 1, 7, [ 0, 1, 2 ], [ 0.25, 0.5, 0.75 ]), 3, | |
245 | "i_psampf channels listed, 3 samples, masked"); | |
29b38678 | 246 | is_color3(Imager::i_get_pixel($imraw, 1, 7), 64, 0, 191, |
7d582d0f TC |
247 | "check color written"); |
248 | Imager::i_img_setmask($imraw, ~0); | |
249 | is(Imager::i_psampf($imraw, 2, 4, [ 0, 1 ], [ 1, 0.5, 0.25, 0.125 ]), 4, | |
250 | "i_psampf channels [0, 1], 4 samples"); | |
29b38678 | 251 | is_color3(Imager::i_get_pixel($imraw, 2, 4), 255, 128, 0, |
7d582d0f | 252 | "check first color written"); |
29b38678 | 253 | is_color3(Imager::i_get_pixel($imraw, 3, 4), 64, 32, 0, |
7d582d0f TC |
254 | "check second color written"); |
255 | is(Imager::i_psampf($imraw, 0, 5, [ 0, 1, 2 ], [ (0.5, 0.25, 0.125) x 10 ]), 30, | |
256 | "write a full row"); | |
257 | is_deeply([ Imager::i_gsamp($imraw, 0, 10, 5, [ 0, 1, 2 ]) ], | |
29b38678 | 258 | [ (128, 64, 32) x 10 ], |
7d582d0f TC |
259 | "check full row"); |
260 | is(Imager::i_psampf($imraw, 8, 8, [ 0, 1, 2 ], | |
261 | [ 1.0, 0.5, 0.125, 0.25, 0.125, 0.0625, 0.125, 0, 1 ]), | |
262 | 6, "i_psampf channels [0, 1, 2], 9 samples, but room for 6"); | |
263 | } | |
264 | { # errors we catch | |
265 | is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, 3 ], [ 1, 0.5, 0.125 ]), | |
266 | undef, "i_psampf channels [0, 1, 3], 3 samples (invalid channel number)"); | |
267 | is(_get_error(), "No channel 3 in this image", | |
268 | "check error message"); | |
269 | is(Imager::i_psampf($imraw, 6, 8, [ 0, 1, -1 ], [ 1, 0.5, 0.125 ]), | |
270 | undef, "i_psampf channels [0, 1, -1], 3 samples (invalid channel number)"); | |
271 | is(_get_error(), "No channel -1 in this image", | |
272 | "check error message"); | |
273 | is(Imager::i_psampf($imraw, 0, -1, undef, [ 0, 0, 0 ]), undef, | |
274 | "negative y"); | |
275 | is(_get_error(), $psamp_outside_error, "check error message"); | |
276 | is(Imager::i_psampf($imraw, 0, 10, undef, [ 0, 0, 0 ]), undef, | |
277 | "y overflow"); | |
278 | is(_get_error(), $psamp_outside_error, "check error message"); | |
279 | is(Imager::i_psampf($imraw, -1, 0, undef, [ 0, 0, 0 ]), undef, | |
280 | "negative x"); | |
281 | is(_get_error(), $psamp_outside_error, "check error message"); | |
282 | is(Imager::i_psampf($imraw, 10, 0, undef, [ 0, 0, 0 ]), undef, | |
283 | "x overflow"); | |
284 | is(_get_error(), $psamp_outside_error, "check error message"); | |
285 | } | |
286 | print "# end psampf tests\n"; | |
287 | } | |
288 | ||
cc59eadc TC |
289 | Imager->close_log; |
290 | ||
291 | unless ($ENV{IMAGER_KEEP_FILES}) { | |
292 | unlink "testout/t022double.log"; | |
293 | } | |
7d582d0f TC |
294 | |
295 | sub _get_error { | |
296 | my @errors = Imager::i_errors(); | |
297 | return join(": ", map $_->[0], @errors); | |
298 | } |