- start of external Imager API access:
[imager.git] / t / t022double.t
CommitLineData
2ce44e2a
TC
1#!perl -w
2use strict;
5c5abac4 3use lib 't';
35f40526 4use Test::More tests => 81;
1501d9b3 5
5c5abac4 6BEGIN { use_ok(Imager => qw(:all :handy)) }
1501d9b3
TC
7require "t/testtools.pl";
8
2ce44e2a
TC
9init_log("testout/t022double.log", 1);
10
11use Imager::Color::Float;
12
13my $im_g = Imager::i_img_double_new(100, 101, 1);
14
5c5abac4 15ok(Imager::i_img_getchannels($im_g) == 1,
2ce44e2a 16 "1 channel image channel count mismatch");
5c5abac4
TC
17ok(Imager::i_img_getmask($im_g) & 1, "1 channel image bad mask");
18ok(Imager::i_img_virtual($im_g) == 0,
2ce44e2a
TC
19 "1 channel image thinks it is virtual");
20my $double_bits = length(pack("d", 1)) * 8;
af3c2450 21print "# $double_bits double bits\n";
5c5abac4 22ok(Imager::i_img_bits($im_g) == $double_bits,
2ce44e2a 23 "1 channel image has bits != $double_bits");
5c5abac4 24ok(Imager::i_img_type($im_g) == 0, "1 channel image isn't direct");
2ce44e2a
TC
25
26my @ginfo = i_img_info($im_g);
5c5abac4
TC
27ok($ginfo[0] == 100, "1 channel image width incorrect");
28ok($ginfo[1] == 101, "1 channel image height incorrect");
2ce44e2a
TC
29
30undef $im_g;
31
32my $im_rgb = Imager::i_img_double_new(100, 101, 3);
33
5c5abac4 34ok(Imager::i_img_getchannels($im_rgb) == 3,
2ce44e2a 35 "3 channel image channel count mismatch");
5c5abac4
TC
36ok((Imager::i_img_getmask($im_rgb) & 7) == 7, "3 channel image bad mask");
37ok(Imager::i_img_bits($im_rgb) == $double_bits,
2ce44e2a 38 "3 channel image has bits != $double_bits");
5c5abac4 39ok(Imager::i_img_type($im_rgb) == 0, "3 channel image isn't direct");
2ce44e2a
TC
40
41my $redf = NCF(1, 0, 0);
42my $greenf = NCF(0, 1, 0);
43my $bluef = NCF(0, 0, 1);
44
45# fill with red
46for my $y (0..101) {
47 Imager::i_plinf($im_rgb, 0, $y, ($redf) x 100);
48}
5c5abac4 49
2ce44e2a 50# basic sanity
5c5abac4
TC
51test_colorf_gpix($im_rgb, 0, 0, $redf);
52test_colorf_gpix($im_rgb, 99, 0, $redf);
53test_colorf_gpix($im_rgb, 0, 100, $redf);
54test_colorf_gpix($im_rgb, 99, 100, $redf);
55test_colorf_glin($im_rgb, 0, 0, ($redf) x 100);
56test_colorf_glin($im_rgb, 0, 100, ($redf) x 100);
2ce44e2a
TC
57
58Imager::i_plinf($im_rgb, 20, 1, ($greenf) x 60);
5c5abac4 59test_colorf_glin($im_rgb, 0, 1,
2ce44e2a
TC
60 ($redf) x 20, ($greenf) x 60, ($redf) x 20);
61
62# basic OO tests
af3c2450 63my $ooimg = Imager->new(xsize=>200, ysize=>201, bits=>'double');
5c5abac4
TC
64ok($ooimg, "couldn't make double image");
65ok($ooimg->bits eq 'double', "oo didn't give double image");
2ce44e2a 66
af3c2450
TC
67# check that the image is copied correctly
68my $oocopy = $ooimg->copy;
92bda632 69is($oocopy->bits, 'double', "oo copy didn't give double image");
2ce44e2a 70
5c5abac4 71ok(!Imager->new(xsize=>0, ysize=>1, bits=>'double'),
1501d9b3 72 "fail making 0 width image");
5c5abac4 73cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
1501d9b3 74 "and correct message");
5c5abac4 75ok(!Imager->new(xsize=>1, ysize=>0, bits=>'double'),
1501d9b3 76 "fail making 0 height image");
5c5abac4 77cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
1501d9b3 78 "and correct message");
5c5abac4 79ok(!Imager->new(xsize=>-1, ysize=>1, bits=>'double'),
1501d9b3 80 "fail making -ve width image");
5c5abac4 81cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
1501d9b3 82 "and correct message");
5c5abac4 83ok(!Imager->new(xsize=>1, ysize=>-1, bits=>'double'),
1501d9b3 84 "fail making -ve height image");
5c5abac4 85cmp_ok(Imager->errstr, '=~', qr/Image sizes must be positive/,
1501d9b3 86 "and correct message");
5c5abac4 87ok(!Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>0),
1501d9b3 88 "fail making 0 channel image");
5c5abac4 89cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
1501d9b3 90 "and correct message");
5c5abac4 91ok(!Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>5),
1501d9b3 92 "fail making 5 channel image");
5c5abac4 93cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/,
1501d9b3
TC
94 "and correct message");
95
653ea321
TC
96{
97 # https://rt.cpan.org/Ticket/Display.html?id=8213
98 # check for handling of memory allocation of very large images
99 # only test this on 32-bit machines - on a 64-bit machine it may
100 # result in trying to allocate 4Gb of memory, which is unfriendly at
101 # least and may result in running out of memory, causing a different
102 # type of exit
103 use Config;
5c5abac4
TC
104 SKIP:
105 {
106 $Config{intsize} == 4
107 or skip "don't want to allocate 4Gb", 8;
4afadaa0 108 my $uint_range = 256 ** $Config{intsize};
653ea321
TC
109 my $dbl_size = $Config{doublesize} || 8;
110 my $dim1 = int(sqrt($uint_range/$dbl_size))+1;
111
112 my $im_b = Imager->new(xsize=>$dim1, ysize=>$dim1, channels=>1, bits=>'double');
5c5abac4 113 is($im_b, undef, "integer overflow check - 1 channel");
653ea321
TC
114
115 $im_b = Imager->new(xisze=>$dim1, ysize=>1, channels=>1, bits=>'double');
5c5abac4 116 ok($im_b, "but same width ok");
653ea321 117 $im_b = Imager->new(xisze=>1, ysize=>$dim1, channels=>1, bits=>'double');
5c5abac4
TC
118 ok($im_b, "but same height ok");
119 cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
653ea321
TC
120 "check the error message");
121
122 # do a similar test with a 3 channel image, so we're sure we catch
123 # the same case where the third dimension causes the overflow
124 my $dim3 = int(sqrt($uint_range / 3 / $dbl_size))+1;
125
126 $im_b = Imager->new(xsize=>$dim3, ysize=>$dim3, channels=>3, bits=>'double');
5c5abac4 127 is($im_b, undef, "integer overflow check - 3 channel");
653ea321 128
5c5abac4
TC
129 $im_b = Imager->new(xsize=>$dim3, ysize=>1, channels=>3, bits=>'double');
130 ok($im_b, "but same width ok");
131 $im_b = Imager->new(xsize=>1, ysize=>$dim3, channels=>3, bits=>'double');
132 ok($im_b, "but same height ok");
653ea321 133
5c5abac4 134 cmp_ok(Imager->errstr, '=~', qr/integer overflow/,
653ea321
TC
135 "check the error message");
136 }
653ea321
TC
137}
138
35f40526 139{ # check the channel mask function
35f40526 140
35f40526
TC
141 my $im = Imager->new(xsize => 10, ysize=>10, bits=>'double');
142
9b8ce4f4 143 mask_tests($im);
35f40526
TC
144}
145
2ce44e2a 146