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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
use warnings;
use strict;
use Math::MPFR qw(:mpfr);
#use Devel::Peek;
print "1..3\n";
my ($exp, $ret);
my $rop = Math::MPFR->new();
my $op1 = Math::MPFR->new(64.75);
my $op2 = Math::MPFR->new(0.25);
my $nan = Math::MPFR->new();
my $zero = Math::MPFR->new(0);
my $unity = Math::MPFR->new(1);
my $inf = $unity / $zero;
my $ninf = -($inf);
my $nzero = $zero * -1;
my $ok = '';
if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) {
$ret = Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN);
if($ret == 0 && $exp == 7 && $rop == 0.505859375) {$ok .= 'a'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $op2, GMP_RNDN);
if($ret == 0 && $exp == -1 && $rop == 0.5) {$ok .= 'b'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, -$op1, GMP_RNDN);
if($ret == 0 && $exp == 7 && $rop == -0.505859375) {$ok .= 'c'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, -$op2, GMP_RNDN);
if($ret == 0 && $exp == -1 && $rop == -0.5) {$ok .= 'd'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $zero, GMP_RNDN);
if($ret == 0 && $exp == 0 && $rop == 0 && Rmpfr_sgn($rop) == 0 && !Rmpfr_signbit($rop)) {$ok .= 'e'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $nzero, GMP_RNDN);
if($ret == 0 && $exp == 0 && $rop == 0 && !Rmpfr_sgn($rop) && Rmpfr_signbit($rop)) {$ok .= 'f'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $nan, GMP_RNDN);
if($ret == 0 && Rmpfr_nan_p($rop)) {$ok .= 'g'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $inf, GMP_RNDN);
if($ret == 0 && Rmpfr_inf_p($rop) && !Rmpfr_signbit($rop)) {$ok .= 'h'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
$ret = Rmpfr_frexp($exp, $rop, $ninf, GMP_RNDN);
if($ret == 0 && Rmpfr_inf_p($rop) && Rmpfr_signbit($rop)) {$ok .= 'i'}
#print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";
if($ok eq 'abcdefghi') {print "ok 1\n"}
else {
warn "1: \$ok: $ok\n";
print "not ok 1\n";
}
}
else {
eval{Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN);};
if($@ =~ /Rmpfr_frexp not implemented/) {print "ok 1\n"}
else {
warn "\$\@: $@";
print "not ok 1\n";
}
}
$ok = '';
$ret = Rmpfr_get_d_2exp($exp, $op1, GMP_RNDN);
if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $op2, GMP_RNDN);
if($exp == -1 && $ret == 0.5) {$ok .= 'b'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, -$op1, GMP_RNDN);
if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, -$op2, GMP_RNDN);
if($exp == -1 && $ret == -0.5) {$ok .= 'd'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $zero, GMP_RNDN);
if($exp == 0 && is_pzero($ret)) {$ok .= 'e'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $nzero, GMP_RNDN);
if($exp == 0 && is_nzero($ret)) {$ok .= 'f'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $nan, GMP_RNDN);
if(is_nan($ret)) {$ok .= 'g'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $inf, GMP_RNDN);
if(is_pinf($ret)) {$ok .= 'h'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_d_2exp($exp, $ninf, GMP_RNDN);
if(is_ninf($ret)) {$ok .= 'i'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
if($ok eq 'abcdefghi') {print "ok 2\n"}
else {
warn "2: \$ok: $ok\n";
print "not ok 2\n";
}
$ok = '';
if(Math::MPFR::_has_longdouble()) {
$ret = Rmpfr_get_ld_2exp($exp, $op1, GMP_RNDN);
if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $op2, GMP_RNDN);
if($exp == -1 && $ret == 0.5) {$ok .= 'b'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, -$op1, GMP_RNDN);
if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, -$op2, GMP_RNDN);
if($exp == -1 && $ret == -0.5) {$ok .= 'd'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $zero, GMP_RNDN);
if($exp == 0 && is_pzero($ret)) {$ok .= 'e'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $nzero, GMP_RNDN);
if($exp == 0 && is_nzero($ret)) {$ok .= 'f'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $nan, GMP_RNDN);
if(is_nan($ret)) {$ok .= 'g'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $inf, GMP_RNDN);
if(is_pinf($ret)) {$ok .= 'h'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
$ret = Rmpfr_get_ld_2exp($exp, $ninf, GMP_RNDN);
if(is_ninf($ret)) {$ok .= 'i'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";
if($ok eq 'abcdefghi') {print "ok 3\n"}
else {
warn "3: \$ok: $ok\n";
print "not ok 3\n";
}
}
else {
warn "Skipping test 3 - no long double support\n";
print "ok 3\n";
}
sub is_nan {
return Rmpfr_nan_p(Math::MPFR->new($_[0]));
}
sub is_pinf {
my $x = Math::MPFR->new($_[0]);
if(Rmpfr_inf_p($x) && !Rmpfr_signbit($x)) {return 1}
return 0;
}
sub is_ninf {
my $x = Math::MPFR->new($_[0]);
if(Rmpfr_inf_p($x) && Rmpfr_signbit($x)) {return 1}
return 0;
}
sub is_pzero {
my $x = Math::MPFR->new($_[0]);
if(Rmpfr_zero_p($x) && !Rmpfr_signbit($x)) {return 1}
return 0;
}
sub is_nzero {
my $x = Math::MPFR->new($_[0]);
if(Rmpfr_zero_p($x) && Rmpfr_signbit($x)) {return 1}
return 0;
}
|
