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; 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; 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) = @_; sprintf("%+.f%+.f%+.f", $z, -$z, - -$z) } 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/;