This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2618865b721b67f557edd7e5b67abfc4ec9e6a56
[perl5.git] / ext / POSIX / t / math.t
1 #!perl -w
2
3 use strict;
4
5 use POSIX ':math_h_c99';
6 use POSIX ':nan_payload';
7 use Test::More;
8
9 use Config;
10
11 # These tests are mainly to make sure that these arithmetic functions
12 # exist and are accessible.  They are not meant to be an exhaustive
13 # test for the interface.
14
15 sub between {
16     my ($low, $have, $high, $desc) = @_;
17     local $Test::Builder::Level = $Test::Builder::Level + 1;
18
19     cmp_ok($have, '>=', $low, $desc);
20     cmp_ok($have, '<=', $high, $desc);
21 }
22
23 is(acos(1), 0, "Basic acos(1) test");
24 between(3.14, acos(-1), 3.15, 'acos(-1)');
25 between(1.57, acos(0), 1.58, 'acos(0)');
26 is(asin(0), 0, "Basic asin(0) test");
27 cmp_ok(asin(1), '>', 1.57, "Basic asin(1) test");
28 cmp_ok(asin(-1), '<', -1.57, "Basic asin(-1) test");
29 cmp_ok(asin(1), '==', -asin(-1), 'asin(1) == -asin(-1)');
30 is(atan(0), 0, "Basic atan(0) test");
31 between(0.785, atan(1), 0.786, 'atan(1)');
32 between(-0.786, atan(-1), -0.785, 'atan(-1)');
33 cmp_ok(atan(1), '==', -atan(-1), 'atan(1) == -atan(-1)');
34 is(cosh(0), 1, "Basic cosh(0) test");  
35 between(1.54, cosh(1), 1.55, 'cosh(1)');
36 between(1.54, cosh(-1), 1.55, 'cosh(-1)');
37 is(cosh(1), cosh(-1), 'cosh(1) == cosh(-1)');
38 is(floor(1.23441242), 1, "Basic floor(1.23441242) test");
39 is(floor(-1.23441242), -2, "Basic floor(-1.23441242) test");
40 is(fmod(3.5, 2.0), 1.5, "Basic fmod(3.5, 2.0) test");
41 is(join(" ", frexp(1)), "0.5 1",  "Basic frexp(1) test");
42 is(ldexp(0,1), 0, "Basic ldexp(0,1) test");
43 is(log10(1), 0, "Basic log10(1) test"); 
44 is(log10(10), 1, "Basic log10(10) test");
45 is(join(" ", modf(1.76)), "0.76 1", "Basic modf(1.76) test");
46 is(sinh(0), 0, "Basic sinh(0) test"); 
47 between(1.17, sinh(1), 1.18, 'sinh(1)');
48 between(-1.18, sinh(-1), -1.17, 'sinh(-1)');
49 is(tan(0), 0, "Basic tan(0) test");
50 between(1.55, tan(1), 1.56, 'tan(1)');
51 between(1.55, tan(1), 1.56, 'tan(-1)');
52 cmp_ok(tan(1), '==', -tan(-1), 'tan(1) == -tan(-1)');
53 is(tanh(0), 0, "Basic tanh(0) test"); 
54 between(0.76, tanh(1), 0.77, 'tanh(1)');
55 between(-0.77, tanh(-1), -0.76, 'tanh(-1)');
56 cmp_ok(tanh(1), '==', -tanh(-1), 'tanh(1) == -tanh(-1)');
57
58 SKIP: {
59     skip "no fpclassify", 4 unless $Config{d_fpclassify};
60     is(fpclassify(1), FP_NORMAL, "fpclassify 1");
61     is(fpclassify(0), FP_ZERO, "fpclassify 0");
62     is(fpclassify(INFINITY), FP_INFINITE, "fpclassify INFINITY");
63     is(fpclassify(NAN), FP_NAN, "fpclassify NAN");
64 }
65
66 sub near {
67     my ($got, $want, $msg, $eps) = @_;
68     $eps ||= 1e-6;
69     cmp_ok(abs($got - $want), '<', $eps, $msg);
70 }
71
72 SKIP: {
73     unless ($Config{d_acosh}) {
74         skip "no acosh, suspecting no C99 math";
75     }
76     if ($^O =~ /Win32|VMS/) {
77         skip "running in $^O, C99 math support uneven";
78     }
79     near(M_SQRT2, 1.4142135623731, "M_SQRT2", 1e-9);
80     near(M_E, 2.71828182845905, "M_E", 1e-9);
81     near(M_PI, 3.14159265358979, "M_PI", 1e-9);
82     near(acosh(2), 1.31695789692482, "acosh", 1e-9);
83     near(asinh(1), 0.881373587019543, "asinh", 1e-9);
84     near(atanh(0.5), 0.549306144334055, "atanh", 1e-9);
85     near(cbrt(8), 2, "cbrt", 1e-9);
86     near(cbrt(-27), -3, "cbrt", 1e-9);
87     near(copysign(3.14, -2), -3.14, "copysign", 1e-9);
88     near(expm1(2), 6.38905609893065, "expm1", 1e-9);
89     near(expm1(1e-6), 1.00000050000017e-06, "expm1", 1e-9);
90     is(fdim(12, 34), 0, "fdim 12 34");
91     is(fdim(34, 12), 22, "fdim 34 12");
92     is(fmax(12, 34), 34, "fmax 12 34");
93     is(fmin(12, 34), 12, "fmin 12 34");
94     is(hypot(3, 4), 5, "hypot 3 4");
95     near(hypot(-2, 1), sqrt(5), "hypot -1 2", 1e-9);
96     is(ilogb(255), 7, "ilogb 255");
97     is(ilogb(256), 8, "ilogb 256");
98     ok(isfinite(1), "isfinite 1");
99     ok(!isfinite(Inf), "isfinite Inf");
100     ok(!isfinite(NaN), "isfinite NaN");
101     ok(isinf(INFINITY), "isinf INFINITY");
102     ok(isinf(Inf), "isinf Inf");
103     ok(!isinf(NaN), "isinf NaN");
104     ok(!isinf(42), "isinf 42");
105     ok(isnan(NAN), "isnan NAN");
106     ok(isnan(NaN), "isnan NaN");
107     ok(!isnan(Inf), "isnan Inf");
108     ok(!isnan(42), "isnan Inf");
109     cmp_ok(nan(), '!=', nan(), 'nan');
110     near(log1p(2), 1.09861228866811, "log1p", 1e-9);
111     near(log1p(1e-6), 9.99999500000333e-07, "log1p", 1e-9);
112     near(log2(8), 3, "log2", 1e-9);
113     is(signbit(2), 0, "signbit 2"); # zero
114     ok(signbit(-2), "signbit -2"); # non-zero
115     is(round(2.25), 2, "round 2.25");
116     is(round(-2.25), -2, "round -2.25");
117     is(round(2.5), 3, "round 2.5");
118     is(round(-2.5), -3, "round -2.5");
119     is(round(2.75), 3, "round 2.75");
120     is(round(-2.75), -3, "round 2.75");
121     is(trunc(2.25), 2, "trunc 2.25");
122     is(trunc(-2.25), -2, "trunc -2.25");
123     is(trunc(2.5), 2, "trunc 2.5");
124     is(trunc(-2.5), -2, "trunc -2.5");
125     is(trunc(2.75), 2, "trunc 2.75");
126     is(trunc(-2.75), -2, "trunc -2.75");
127     ok(isless(1, 2), "isless 1 2");
128     ok(!isless(2, 1), "isless 2 1");
129     ok(!isless(1, 1), "isless 1 1");
130     ok(!isless(1, NaN), "isless 1 NaN");
131     ok(isgreater(2, 1), "isgreater 2 1");
132     ok(islessequal(1, 1), "islessequal 1 1");
133     ok(isunordered(1, NaN), "isunordered 1 NaN");
134
135     near(erf(0.5), 0.520499877813047, "erf 0.5", 1.5e-7);
136     near(erf(1), 0.842700792949715, "erf 1", 1.5e-7);
137     near(erf(9), 1, "erf 9", 1.5e-7);
138     near(erfc(0.5), 0.479500122186953, "erfc 0.5", 1.5e-7);
139     near(erfc(1), 0.157299207050285, "erfc 1", 1.5e-7);
140     near(erfc(9), 0, "erfc 9", 1.5e-7);
141
142     # tgamma(n) = (n - 1)!
143     # lgamma(n) = log(tgamma(n))
144     near(tgamma(5), 24, "tgamma 5", 1.5e-7);
145     near(tgamma(5.5), 52.3427777845535, "tgamma 5.5", 1.5e-7);
146     near(tgamma(9), 40320, "tgamma 9", 1.5e-7);
147     near(lgamma(5), 3.17805383034795, "lgamma 4", 1.5e-7);
148     near(lgamma(5.5), 3.95781396761872, "lgamma 5.5", 1.5e-7);
149     near(lgamma(9), 10.6046029027452, "lgamma 9", 1.5e-7);
150
151     # These don't work on old mips/hppa platforms because == Inf (or == -Inf).
152     # ok(isnan(setpayload(0)), "setpayload zero");
153     # is(getpayload(setpayload(0)), 0, "setpayload + getpayload (zero)");
154     #
155     # These don't work on most platforms because == Inf (or == -Inf).
156     # ok(isnan(setpayloadsig(0)), "setpayload zero");
157     # is(getpayload(setpayloadsig(0)), 0, "setpayload + getpayload (zero)");
158
159     # Verify that the payload set be setpayload()
160     # (1) still is a nan
161     # (2) but the payload can be retrieved
162     # (3) but is not signaling
163     my $x = 0;
164     setpayload($x, 0x12345);
165     ok(isnan($x), "setpayload + isnan");
166     is(getpayload($x), 0x12345, "setpayload + getpayload");
167     ok(!issignaling($x), "setpayload + issignaling");
168
169     # Verify that the signaling payload set be setpayloadsig()
170     # (1) still is a nan
171     # (2) but the payload can be retrieved
172     # (3) and is signaling
173     setpayloadsig($x, 0x12345);
174     ok(isnan($x), "setpayloadsig + isnan");
175     is(getpayload($x), 0x12345, "setpayload + getpayload");
176     ok(issignaling($x), "setpayloadsig + issignaling");
177
178     # Try a payload more than one byte.
179     is(getpayload(nan(0x12345)), 0x12345, "nan + getpayload");
180
181     # Try payloads of 2^k, most importantly at and beyond 2^32.  These
182     # tests will fail if NV is just 32-bit float, but that Should Not
183     # Happen (tm).
184     is(getpayload(nan(2**31)), 2**31, "nan + getpayload 2**31");
185     is(getpayload(nan(2**32)), 2**32, "nan + getpayload 2**32");
186     is(getpayload(nan(2**33)), 2**33, "nan + getpayload 2**33");
187
188     # Payloads just lower than 2^k.
189     is(getpayload(nan(2**31-1)), 2**31-1, "nan + getpayload 2**31-1");
190     is(getpayload(nan(2**32-1)), 2**32-1, "nan + getpayload 2**32-1");
191
192     # Payloads not divisible by two (and larger than 2**32).
193
194     SKIP: {
195         # solaris gets 10460353202 from getpayload() when it should
196         # get 10460353203 (the 3**21). Things go wrong already in
197         # the nan() payload setting: [0x2, 0x6f7c52b4] (ivsize=4)
198         # instead [0x2, 0x6f7c52b3].  Then at getpayload() things
199         # go wrong again, now in other direction: with the (wrong)
200         # [0x2, 0x6f7c52b4] encoded in the nan we should decode into
201         # 10460353204, but we get 10460353202.  It doesn't seem to
202         # help even if we use 'unsigned long long' instead of UV/U32
203         # in the POSIX.xs:S_setpayload/S_getpayload.
204         #
205         # casting bug?  fmod() bug?  Though also broken with
206         # -Duselongdouble + fmodl(), so maybe Solaris cc bug
207         # in general?
208         #
209         # Ironically, the large prime seems to work even in Solaris,
210         # probably just by blind luck.
211         skip($^O, 1) if $^O eq 'solaris';
212         is(getpayload(nan(3**21)), 3**21, "nan + getpayload 3**21");
213     }
214     is(getpayload(nan(4294967311)), 4294967311, "nan + getpayload prime");
215
216     # Truncates towards zero.
217     is(getpayload(nan(1234.567)), 1234, "nan (trunc) + getpayload");
218
219     # Not signaling.
220     ok(!issignaling(0), "issignaling zero");
221     ok(!issignaling(+Inf), "issignaling +Inf");
222     ok(!issignaling(-Inf), "issignaling -Inf");
223     ok(!issignaling(NaN), "issignaling NaN");
224 } # SKIP
225
226 done_testing();