use strict;
-use POSIX;
+use POSIX ':math_h_c99';
+use POSIX ':nan_payload';
use Test::More;
use Config;
cmp_ok(tanh(1), '==', -tanh(-1), 'tanh(1) == -tanh(-1)');
SKIP: {
+ skip "no fpclassify", 4 unless $Config{d_fpclassify};
+ is(fpclassify(1), FP_NORMAL, "fpclassify 1");
+ is(fpclassify(0), FP_ZERO, "fpclassify 0");
+ is(fpclassify(INFINITY), FP_INFINITE, "fpclassify INFINITY");
+ is(fpclassify(NAN), FP_NAN, "fpclassify NAN");
+}
+
+sub near {
+ my ($got, $want, $msg, $eps) = @_;
+ $eps ||= 1e-6;
+ cmp_ok(abs($got - $want), '<', $eps, $msg);
+}
+
+SKIP: {
unless ($Config{d_acosh}) {
- skip "no acosh, suspecting no C99 math", 30;
+ skip "no acosh, suspecting no C99 math";
}
if ($^O =~ /Win32|VMS/) {
- skip "running in $^O, C99 math support uneven", 30;
+ skip "running in $^O, C99 math support uneven";
}
- cmp_ok(abs(M_SQRT2 - 1.4142135623731), '<', 1e-9, "M_SQRT2");
- cmp_ok(abs(M_E - 2.71828182845905), '<', 1e-9, "M_E");
- cmp_ok(abs(M_PI - 3.14159265358979), '<', 1e-9, "M_PI");
- cmp_ok(abs(acosh(2) - 1.31695789692482), '<', 1e-9, "acosh");
- cmp_ok(abs(asinh(1) - 0.881373587019543), '<', 1e-9, "asinh");
- cmp_ok(abs(atanh(0.5) - 0.549306144334055), '<', 1e-9, "atanh");
- cmp_ok(abs(cbrt(8) - 2), '<', 1e-9, "cbrt");
- cmp_ok(abs(cbrt(-27) - -3), '<', 1e-9, "cbrt");
- cmp_ok(abs(copysign(3.14, -2) - -3.14), '<', 1e-9, "copysign");
- cmp_ok(abs(expm1(2) - 6.38905609893065), '<', 1e-9, "expm1");
- cmp_ok(abs(expm1(1e-6) - 1.00000050000017e-06), '<', 1e-9, "expm1");
+ near(M_SQRT2, 1.4142135623731, "M_SQRT2", 1e-9);
+ near(M_E, 2.71828182845905, "M_E", 1e-9);
+ near(M_PI, 3.14159265358979, "M_PI", 1e-9);
+ near(acosh(2), 1.31695789692482, "acosh", 1e-9);
+ near(asinh(1), 0.881373587019543, "asinh", 1e-9);
+ near(atanh(0.5), 0.549306144334055, "atanh", 1e-9);
+ near(cbrt(8), 2, "cbrt", 1e-9);
+ near(cbrt(-27), -3, "cbrt", 1e-9);
+ near(copysign(3.14, -2), -3.14, "copysign", 1e-9);
+ near(expm1(2), 6.38905609893065, "expm1", 1e-9);
+ near(expm1(1e-6), 1.00000050000017e-06, "expm1", 1e-9);
is(fdim(12, 34), 0, "fdim 12 34");
is(fdim(34, 12), 22, "fdim 34 12");
is(fmax(12, 34), 34, "fmax 12 34");
is(fmin(12, 34), 12, "fmin 12 34");
- SKIP: {
- unless ($Config{d_fpclassify}) {
- skip "no fpclassify", 4;
- }
- is(fpclassify(1), FP_NORMAL, "fpclassify 1");
- is(fpclassify(0), FP_ZERO, "fpclassify 0");
- is(fpclassify(INFINITY), FP_INFINITE, "fpclassify INFINITY");
- is(fpclassify(NAN), FP_NAN, "fpclassify NAN");
- }
is(hypot(3, 4), 5, "hypot 3 4");
- cmp_ok(abs(hypot(-2, 1) - sqrt(5)), '<', 1e-9, "hypot -1 2");
+ near(hypot(-2, 1), sqrt(5), "hypot -1 2", 1e-9);
is(ilogb(255), 7, "ilogb 255");
is(ilogb(256), 8, "ilogb 256");
- SKIP: {
- unless ($Config{d_isfinite}) {
- skip "no isfinite", 3;
- }
- ok(isfinite(1), "isfinite 1");
- ok(!isfinite(Inf), "isfinite Inf");
- ok(!isfinite(NaN), "isfinite NaN");
- }
- SKIP: {
- unless ($Config{d_isinf}) {
- skip "no isinf", 4;
- }
- ok(isinf(INFINITY), "isinf INFINITY");
- ok(isinf(Inf), "isinf Inf");
- ok(!isinf(NaN), "isinf NaN");
- ok(!isinf(42), "isinf 42");
- }
- SKIP: {
- unless ($Config{d_isnan}) {
- skip "no isnan", 4;
- }
- ok(isnan(NAN), "isnan NAN");
- ok(isnan(NaN), "isnan NaN");
- ok(!isnan(Inf), "isnan Inf");
- ok(!isnan(42), "isnan Inf");
- }
+ ok(isfinite(1), "isfinite 1");
+ ok(!isfinite(Inf), "isfinite Inf");
+ ok(!isfinite(NaN), "isfinite NaN");
+ ok(isinf(INFINITY), "isinf INFINITY");
+ ok(isinf(Inf), "isinf Inf");
+ ok(!isinf(NaN), "isinf NaN");
+ ok(!isinf(42), "isinf 42");
+ ok(isnan(NAN), "isnan NAN");
+ ok(isnan(NaN), "isnan NaN");
+ ok(!isnan(Inf), "isnan Inf");
+ ok(!isnan(42), "isnan Inf");
cmp_ok(nan(), '!=', nan(), 'nan');
- cmp_ok(abs(log1p(2) - 1.09861228866811), '<', 1e-9, "log1p");
- cmp_ok(abs(log1p(1e-6) - 9.99999500000333e-07), '<', 1e-9, "log1p");
- cmp_ok(abs(log2(8) - 3), '<', 1e-9, "log2");
- SKIP: {
- unless ($Config{d_signbit}) {
- skip "no signbit", 2;
- }
- is(signbit(2), 0, "signbit 2"); # zero
- ok(signbit(-2), "signbit -2"); # non-zero
- }
+ near(log1p(2), 1.09861228866811, "log1p", 1e-9);
+ near(log1p(1e-6), 9.99999500000333e-07, "log1p", 1e-9);
+ near(log2(8), 3, "log2", 1e-9);
+ is(signbit(2), 0, "signbit 2"); # zero
+ ok(signbit(-2), "signbit -2"); # non-zero
is(round(2.25), 2, "round 2.25");
is(round(-2.25), -2, "round -2.25");
is(round(2.5), 3, "round 2.5");
ok(isgreater(2, 1), "isgreater 2 1");
ok(islessequal(1, 1), "islessequal 1 1");
ok(isunordered(1, NaN), "isunordered 1 NaN");
- cmp_ok(abs(erf(1) - 0.842700792949715), '<', 1.5e-7, "erf 1");
- cmp_ok(abs(erfc(1) - 0.157299207050285), '<', 1.5e-7, "erfc 1");
-}
+
+ near(erf(0.5), 0.520499877813047, "erf 0.5", 1.5e-7);
+ near(erf(1), 0.842700792949715, "erf 1", 1.5e-7);
+ near(erf(9), 1, "erf 9", 1.5e-7);
+ near(erfc(0.5), 0.479500122186953, "erfc 0.5", 1.5e-7);
+ near(erfc(1), 0.157299207050285, "erfc 1", 1.5e-7);
+ near(erfc(9), 0, "erfc 9", 1.5e-7);
+
+ # tgamma(n) = (n - 1)!
+ # lgamma(n) = log(tgamma(n))
+ near(tgamma(5), 24, "tgamma 5", 1.5e-7);
+ near(tgamma(5.5), 52.3427777845535, "tgamma 5.5", 1.5e-7);
+ near(tgamma(9), 40320, "tgamma 9", 1.5e-7);
+ near(lgamma(5), 3.17805383034795, "lgamma 4", 1.5e-7);
+ near(lgamma(5.5), 3.95781396761872, "lgamma 5.5", 1.5e-7);
+ near(lgamma(9), 10.6046029027452, "lgamma 9", 1.5e-7);
+
+ # These don't work on old mips/hppa platforms because == Inf (or == -Inf).
+ # ok(isnan(setpayload(0)), "setpayload zero");
+ # is(getpayload(setpayload(0)), 0, "setpayload + getpayload (zero)");
+ #
+ # These don't work on most platforms because == Inf (or == -Inf).
+ # ok(isnan(setpayloadsig(0)), "setpayload zero");
+ # is(getpayload(setpayloadsig(0)), 0, "setpayload + getpayload (zero)");
+
+ # Verify that the payload set be setpayload()
+ # (1) still is a nan
+ # (2) but the payload can be retrieved
+ # (3) but is not signaling
+ my $x = 0;
+ setpayload($x, 0x12345);
+ ok(isnan($x), "setpayload + isnan");
+ is(getpayload($x), 0x12345, "setpayload + getpayload");
+ ok(!issignaling($x), "setpayload + issignaling");
+
+ # Verify that the signaling payload set be setpayloadsig()
+ # (1) still is a nan
+ # (2) but the payload can be retrieved
+ # (3) and is signaling
+ setpayloadsig($x, 0x12345);
+ ok(isnan($x), "setpayloadsig + isnan");
+ is(getpayload($x), 0x12345, "setpayloadsig + getpayload");
+ SKIP: {
+ # https://rt.perl.org/Ticket/Display.html?id=125710
+ # In the 32-bit x86 ABI cannot preserve the signaling bit
+ # (the x87 simply does not preserve that). But using the
+ # 80-bit extended format aka long double, the bit is preserved.
+ # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57484
+ my $could_be_x86_32 =
+ # This is a really weak test: there are other 32-bit
+ # little-endian platforms than just Intel (some embedded
+ # processors, for example), but we use this just for not
+ # bothering with the test if things look iffy.
+ # We could, say, $Config{ccsymbols} =~ /\b__[xi][3-7]86=1\b/,
+ # but that feels quite shaky.
+ $Config{byteorder} eq '1234' &&
+ $Config{ivsize} == 4 && # Really redundant with the 'byteorder'.
+ $Config{ptrsize} == 4;
+ skip($^O, 1) if $could_be_x86_32 && !$Config{uselongdouble};
+ ok(issignaling($x), "setpayloadsig + issignaling");
+ }
+
+ # Try a payload more than one byte.
+ is(getpayload(nan(0x12345)), 0x12345, "nan + getpayload");
+
+ # Try payloads of 2^k, most importantly at and beyond 2^32. These
+ # tests will fail if NV is just 32-bit float, but that Should Not
+ # Happen (tm).
+ is(getpayload(nan(2**31)), 2**31, "nan + getpayload 2**31");
+ is(getpayload(nan(2**32)), 2**32, "nan + getpayload 2**32");
+ is(getpayload(nan(2**33)), 2**33, "nan + getpayload 2**33");
+
+ # Payloads just lower than 2^k.
+ is(getpayload(nan(2**31-1)), 2**31-1, "nan + getpayload 2**31-1");
+ is(getpayload(nan(2**32-1)), 2**32-1, "nan + getpayload 2**32-1");
+
+ # Payloads not divisible by two (and larger than 2**32).
+
+ SKIP: {
+ # solaris gets 10460353202 from getpayload() when it should
+ # get 10460353203 (the 3**21). Things go wrong already in
+ # the nan() payload setting: [0x2, 0x6f7c52b4] (ivsize=4)
+ # instead [0x2, 0x6f7c52b3]. Then at getpayload() things
+ # go wrong again, now in other direction: with the (wrong)
+ # [0x2, 0x6f7c52b4] encoded in the nan we should decode into
+ # 10460353204, but we get 10460353202. It doesn't seem to
+ # help even if we use 'unsigned long long' instead of UV/U32
+ # in the POSIX.xs:S_setpayload/S_getpayload.
+ #
+ # casting bug? fmod() bug? Though also broken with
+ # -Duselongdouble + fmodl(), so maybe Solaris cc bug
+ # in general?
+ #
+ # Ironically, the large prime seems to work even in Solaris,
+ # probably just by blind luck.
+ skip($^O, 1) if $^O eq 'solaris';
+ is(getpayload(nan(3**21)), 3**21, "nan + getpayload 3**21");
+ }
+ is(getpayload(nan(4294967311)), 4294967311, "nan + getpayload prime");
+
+ # Truncates towards zero.
+ is(getpayload(nan(1234.567)), 1234, "nan (trunc) + getpayload");
+
+ # Not signaling.
+ ok(!issignaling(0), "issignaling zero");
+ ok(!issignaling(+Inf), "issignaling +Inf");
+ ok(!issignaling(-Inf), "issignaling -Inf");
+ ok(!issignaling(NaN), "issignaling NaN");
+} # SKIP
done_testing();
https://perl5.git.perl.org / perl5.git / blobdiff