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
|
use warnings;
use strict;
use Test::More tests => 102;
BEGIN { use_ok "Data::Float", qw(
float_hex hex_float
have_signed_zero have_infinite have_nan float_is_nan
); }
my %str_opt = (
exp_neg_sign => "(ENS)", exp_pos_sign => "(EPS)",
hex_prefix_string => "(HEX)",
infinite_string => "(INF)", nan_string => "(NAN)",
neg_sign => "(VNS)", pos_sign => "(VPS)",
zero_strategy => "STRING=(ZERO)",
);
SKIP: {
skip "no infinities", 22 unless have_infinite;
no strict "refs";
my $pinf = &{"Data::Float::pos_infinity"};
my $ninf = &{"Data::Float::neg_infinity"};
is float_hex($pinf), "+inf";
is float_hex($ninf), "-inf";
is float_hex($pinf, \%str_opt), "(VPS)(INF)";
is float_hex($ninf, \%str_opt), "(VNS)(INF)";
ok hex_float("inf") == $pinf;
ok hex_float("Inf") == $pinf;
ok hex_float("iNf") == $pinf;
ok hex_float("+inf") == $pinf;
ok hex_float("+Inf") == $pinf;
ok hex_float("+iNf") == $pinf;
ok hex_float("-inf") == $ninf;
ok hex_float("-Inf") == $ninf;
ok hex_float("-iNf") == $ninf;
ok hex_float("infinity") == $pinf;
ok hex_float("Infinity") == $pinf;
ok hex_float("iNfiniTy") == $pinf;
ok hex_float("+infinity") == $pinf;
ok hex_float("+Infinity") == $pinf;
ok hex_float("+iNfiniTy") == $pinf;
ok hex_float("-infinity") == $ninf;
ok hex_float("-Infinity") == $ninf;
ok hex_float("-iNfiniTy") == $ninf;
}
SKIP: {
skip "no NaN", 20 unless have_nan;
no strict "refs";
is float_hex(&{"Data::Float::nan"}), "nan";
is float_hex(&{"Data::Float::nan"}, \%str_opt), "(NAN)";
ok float_is_nan(hex_float("nan"));
ok float_is_nan(hex_float("Nan"));
ok float_is_nan(hex_float("nAn"));
ok float_is_nan(hex_float("+nan"));
ok float_is_nan(hex_float("+Nan"));
ok float_is_nan(hex_float("+nAn"));
ok float_is_nan(hex_float("-nan"));
ok float_is_nan(hex_float("-Nan"));
ok float_is_nan(hex_float("-nAn"));
ok float_is_nan(hex_float("snan"));
ok float_is_nan(hex_float("sNan"));
ok float_is_nan(hex_float("SnAn"));
ok float_is_nan(hex_float("+snan"));
ok float_is_nan(hex_float("+sNan"));
ok float_is_nan(hex_float("+SnAn"));
ok float_is_nan(hex_float("-snan"));
ok float_is_nan(hex_float("-sNan"));
ok float_is_nan(hex_float("-SnAn"));
}
my %opt = ( frac_digits_bits_mod => "IGNORE" );
foreach([ +1, "+0x1p+0" ],
[ +3.75, "+0x1.ep+1" ],
[ -3.75, "-0x1.ep+1" ],
[ +0.375, "+0x1.8p-2" ],
[ +1.09375, "+0x1.18p+0" ],
) {
my($val, $hex) = @$_;
is float_hex($val, \%opt), $hex;
ok hex_float($hex) == $val;
}
ok hex_float("1.ep1") == +3.75;
ok hex_float("3.c") == +3.75;
ok hex_float("1ep-3") == +3.75;
ok hex_float("0.01ep9") == +3.75;
foreach(1023013230.1, 1.23e30, 3.564e-30) {
ok hex_float(float_hex($_)) == $_;
}
sub zpat($) { my($z) = @_; my $nz = -$z; sprintf("%+.f%+.f%+.f",$z,$nz,-$nz) }
my $z;
$z = 0; is float_hex($z), "+0.0"; is zpat($z), "+0+0+0";
SKIP: {
skip "no signed zero", 4 unless have_signed_zero;
$z = +0.0; is float_hex($z), "+0.0"; is zpat($z), "+0-0+0";
$z = -0.0; is float_hex($z), "-0.0"; is zpat($z), "-0+0-0";
}
is float_hex(0, \%str_opt), "(VPS)(ZERO)";
like float_hex(0, { %str_opt, zero_strategy => "SUBNORMAL" }),
qr/\A\(VPS\)\(HEX\)0\.0+p\(ENS\)[1-9][0-9]*\z/;
like float_hex(0, { %str_opt, zero_strategy => "EXPONENT=-33" }),
qr/\A\(VPS\)\(HEX\)0\.0+p\(ENS\)33\z/;
$z = hex_float("0"); is zpat($z), zpat(+0.0); ok $z == 0.0;
$z = hex_float("+0"); is zpat($z), zpat(+0.0); ok $z == 0.0;
$z = hex_float("-0"); is zpat($z), zpat(-0.0); ok $z == 0.0;
$z = hex_float("0.0"); is zpat($z), zpat(+0.0); ok $z == 0.0;
$z = hex_float("+0.0"); is zpat($z), zpat(+0.0); ok $z == 0.0;
$z = hex_float("-0.0"); is zpat($z), zpat(-0.0); ok $z == 0.0;
like float_hex(2, { exp_digits => 5 }), qr/\A\+0x1\.0+p\+00001\z/;
like float_hex(2, { exp_digits_range_mod => "ATLEAST" }),
qr/\A\+0x1\.0+p\+0+1\z/;
%opt = ( %str_opt, frac_digits_bits_mod => "IGNORE" );
is float_hex(+3.75, \%opt), "(VPS)(HEX)1.ep(EPS)1";
is float_hex(-3.75, \%opt), "(VNS)(HEX)1.ep(EPS)1";
is float_hex(+0.375, \%opt), "(VPS)(HEX)1.8p(ENS)2";
is float_hex(-0.375, \%opt), "(VNS)(HEX)1.8p(ENS)2";
is float_hex(+3.75, { frac_digits => 5, frac_digits_bits_mod => "IGNORE" }),
"+0x1.e0000p+1";
is float_hex(+3.75, { frac_digits => 1, frac_digits_bits_mod => "IGNORE" }),
"+0x1.ep+1";
is float_hex(+1.09375, { frac_digits => 5, frac_digits_bits_mod => "IGNORE" }),
"+0x1.18000p+0";
is float_hex(+1.09375, { frac_digits => 2, frac_digits_bits_mod => "IGNORE" }),
"+0x1.18p+0";
is float_hex(+1.09375, { frac_digits => 1, frac_digits_bits_mod => "IGNORE" }),
"+0x1.18p+0";
%opt = ( frac_digits_bits_mod => "IGNORE", frac_digits_value_mod => "IGNORE" );
is float_hex(+1.09375, { %opt, frac_digits => 5 }), "+0x1.18000p+0";
is float_hex(+1.09375, { %opt, frac_digits => 2 }), "+0x1.18p+0";
is float_hex(+1.09375, { %opt, frac_digits => 1 }), "+0x1.2p+0";
is float_hex(+1.09375, { %opt, frac_digits => 0 }), "+0x1p+0";
is float_hex(+1.90625, { %opt, frac_digits => 5 }), "+0x1.e8000p+0";
is float_hex(+1.90625, { %opt, frac_digits => 2 }), "+0x1.e8p+0";
is float_hex(+1.90625, { %opt, frac_digits => 1 }), "+0x1.ep+0";
is float_hex(+1.90625, { %opt, frac_digits => 0 }), "+0x1p+1";
like float_hex(1, { exp_digits_range_mod => "ATLEAST" }),
qr/\A\+0x1\.0+p\+00+\z/;
like float_hex(1, { exp_digits => 5 }), qr/\A\+0x1\.0+p\+00000\z/;
1;
|
