double-double long double %a fixes

- reserve enough buffer space
- name the two different errors differently
- test around the problem spot

1 files changed, 11 insertions, 7 deletions

diff --git a/sv.c b/sv.c
index 383f53d638..dff55c95e9 100644
--- a/sv.c
+++ b/sv.c
@@ -1,4 +1,4 @@
-/*    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
@@ -10713,7 +10713,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
  * 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
@@ -10810,7 +10810,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
 
     /* 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
@@ -10818,8 +10818,10 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
     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)
@@ -11025,8 +11027,10 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
          * 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;
 }