-/* sv.c
+/* sv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall
* The non-double-double-long-double overshoots since all bits of NV
* are not mantissa bits, there are also exponent bits. */
#ifdef LONGDOUBLE_DOUBLEDOUBLE
-# define VHEX_SIZE (1+DOUBLEDOUBLE_MAXBITS/4)
+# define VHEX_SIZE (3+DOUBLEDOUBLE_MAXBITS/4)
#else
# define VHEX_SIZE (1+(NVSIZE * 8)/4)
#endif
/* HEXTRACTSIZE is the maximum number of xdigits. */
#if defined(USE_LONG_DOUBLE) && defined(LONGDOUBLE_DOUBLEDOUBLE)
-# define HEXTRACTSIZE (DOUBLEDOUBLE_MAXBITS/4)
+# define HEXTRACTSIZE (2+DOUBLEDOUBLE_MAXBITS/4)
#else
# define HEXTRACTSIZE 2 * NVSIZE
#endif
const U8* vmaxend = vhex + HEXTRACTSIZE;
PERL_UNUSED_VAR(ix); /* might happen */
(void)Perl_frexp(PERL_ABS(nv), exponent);
- if (vend && (vend <= vhex || vend > vmaxend))
- Perl_croak(aTHX_ "Hexadecimal float: internal error");
+ if (vend && (vend <= vhex || vend > vmaxend)) {
+ /* diag_listed_as: Hexadecimal float: internal error (%s) */
+ Perl_croak(aTHX_ "Hexadecimal float: internal error (entry)");
+ }
{
/* First check if using long doubles. */
#if defined(USE_LONG_DOUBLE) && (NVSIZE > DOUBLESIZE)
* which is convenient since the HEXTRACTSIZE is tricky
* for double-double. */
ixmin < 0 || ixmax >= NVSIZE ||
- (vend && v != vend))
- Perl_croak(aTHX_ "Hexadecimal float: internal error");
+ (vend && v != vend)) {
+ /* diag_listed_as: Hexadecimal float: internal error (%s) */
+ Perl_croak(aTHX_ "Hexadecimal float: internal error (overflow)");
+ }
return v;
}
print "# no hexfloat tests\n";
}
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat;
+plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 6;
use strict;
use Config;
}
ok($ok, "'$format' '$arg' -> '$result' cf '$expected'");
}
+
+# double-double long double %a special testing.
+SKIP: {
+ skip("$^O doublekind=$Config{doublekind}", 6)
+ unless ($Config{doublekind} == 4 && $^O eq 'linux');
+ # [rt.perl.org 125633]
+ like(sprintf("%La\n", (2**1020) + (2**-1072)),
+ qr/^0x1.0{522}1p\+1020$/);
+ like(sprintf("%La\n", (2**1021) + (2**-1072)),
+ qr/^0x1.0{523}8p\+1021$/);
+ like(sprintf("%La\n", (2**1022) + (2**-1072)),
+ qr/^0x1.0{523}4p\+1022$/);
+ like(sprintf("%La\n", (2**1023) + (2**-1072)),
+ qr/^0x1.0{523}2p\+1023$/);
+ like(sprintf("%La\n", (2**1023) + (2**-1073)),
+ qr/^0x1.0{523}1p\+1023$/);
+ like(sprintf("%La\n", (2**1023) + (2**-1074)),
+ qr/^0x1.0{524}8p\+1023$/);
+}