1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
# Check that scalars that are (or might be)
# both POK and NOK are being handled correctly.
use strict;
use warnings;
use Math::MPFR qw(:mpfr);
*_ITSA = \&Math::MPFR::_itsa;
use Test::More;
warn "\n MPFR_PV_NV_BUG set to ", MPFR_PV_NV_BUG, "\n";
warn " The string 'nan' apparently numifies to zero\n"
if 'nan' + 0 == 0;
# Check that both the perl environment and the XS
# environment agree on whether the problem is present.
cmp_ok(MPFR_PV_NV_BUG, '==', Math::MPFR::_has_pv_nv_bug(),
"Perl environment and XS environment agree"); # Test 1
my $nv_1 = 1.3;
my $s = "$nv_1";
cmp_ok(_ITSA($nv_1), '==', 3, "NV slot will be used"); # Test 2
my $nv_2 = '1.7';
if($nv_2 > 1) { # True
cmp_ok(_ITSA($nv_2), '==', 4, "PV slot will be used"); # Test 3
}
my $pv_finite = '5e5000';
if($pv_finite > 0) { # True
my $fr = Math::MPFR->new($pv_finite);
cmp_ok("$fr", 'eq', '5.0000000000000002e5000',
"'5e5000' is not an Inf"); # Test 4
}
if('nan' + 0 != 'nan' + 0) { # Skip if numification of
# 'nan' fails to DWIM
my $pv_nan = 'nan';
if($pv_nan != 42) { # True
my $fr = Math::MPFR->new($pv_nan);
cmp_ok(Rmpfr_nan_p($fr), '!=', 0,
"NaN Math::MPFR object was created"); # Test 5
}
}
else { # Instead verify that 'nan' numifies to zero
cmp_ok('nan' + 0, '==', 0, "'nan' numifies to zero"); # Test 5 alt.
}
if('inf' + 0 > 0) { # Skip if numification of
# 'inf' fails to DWIM
my $pv_inf = 'inf';
if($pv_inf > 0) { # True
my $fr = Math::MPFR->new($pv_inf);
cmp_ok(Rmpfr_inf_p($fr), '!=', 0,
"Inf Math::MPFR object was created"); # Test 6
}
}
else { # Instead verify that 'inf' numifies to zero
cmp_ok('inf' + 0, '==', 0, "'inf' numifies to zero"); # Test 6 alt.
}
my $nv_inf = Rmpfr_get_NV(Math::MPFR->new('Inf'), MPFR_RNDN);
$s = "$nv_inf";
cmp_ok(Rmpfr_inf_p(Math::MPFR->new($nv_inf)), '!=', 0,
"Inf Math::MPFR object was created"); # Test 7
my $nv_nan = Rmpfr_get_NV(Math::MPFR->new(), MPFR_RNDN);
$s = "$nv_nan";
cmp_ok(Rmpfr_nan_p(Math::MPFR->new($nv_nan)), '!=', 0,
"NaN Math::MPFR object was created"); # Test 8
Rmpfr_set_default_prec($Math::MPFR::NV_properties{bits});
my $mpfr_sqrt = sqrt(Math::MPFR->new(2));
my $perl_sqrt = Rmpfr_get_NV($mpfr_sqrt, MPFR_RNDN); # sqrt(2) as NV
my $str = "$perl_sqrt"; # sqrt(2) as decimal string, rounded twice.
if($str > 0) {
cmp_ok(_ITSA($str), '==', 4,
"Correctly designated a PV"); # Test 9
cmp_ok(_ITSA($perl_sqrt), '==', 3,
"Correctly designated as an NV"); # Test 10
}
my $nv_sqrt = sqrt(2);
my $str_sqrt = "$nv_sqrt";
# The next 4 tests should fail if the value
# in the PV slot of $nv_sqrt is used.
cmp_ok(Math::MPFR->new(1) * $nv_sqrt, '==', sqrt(2),
"overload_mul() uses value in NV slot"); # Test 11
cmp_ok(Math::MPFR->new(0) + $nv_sqrt, '==', sqrt(2),
"overload_add() uses value in NV slot"); # Test 12
cmp_ok(Math::MPFR->new(0) - $nv_sqrt, '==', -(sqrt(2)),
"overload_sub() uses value in NV slot"); # Test 13
cmp_ok(Math::MPFR->new(sqrt 2) / $nv_sqrt, '==', 1.0,
"overload_div() uses value in NV slot"); # Test 14
done_testing();
|
