This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hexadecimal float sprintf, for perl #122219
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 12 Aug 2014 12:30:56 +0000 (08:30 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Thu, 14 Aug 2014 02:43:53 +0000 (22:43 -0400)
Do not use the system sprintf since %a/%A is C99 (which we do not
require), and even if we did, there is room for interpretation
(for example whether to print trailing zeros or not) which means
that existing implementations will inevitably differ.

For the most common case, 64-bit doubles of IEEE 754, use first
frexp to extract the exponent, and then ldexp to scale the result
to a 64-bit unsigned integer.

For long doubles (80-bit or 128-bit) we look directly at the mantissa
(also known as fraction, or significand) bytes, and their 4-bit nybbles,
and extract them in correct order.

Since we bypass system printf, we need to do our own aligning, filling,
rounding, and other printf logic.

perl.h
pod/perldiag.pod
pod/perlfunc.pod
sv.c
t/op/sprintf.t
t/op/sprintf2.t

diff --git a/perl.h b/perl.h
index c8537c3..80238d9 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1842,12 +1842,21 @@ typedef NVTYPE NV;
 #   ifdef LDBL_MANT_DIG
 #       define NV_MANT_DIG LDBL_MANT_DIG
 #   endif
+#   ifdef LDBL_MANT_BITS
+#       define NV_MANT_BITS LDBL_MANT_BITS
+#   endif
 #   ifdef LDBL_MIN
 #       define NV_MIN LDBL_MIN
 #   endif
 #   ifdef LDBL_MAX
 #       define NV_MAX LDBL_MAX
 #   endif
+#   ifdef LDBL_MIN_EXP
+#       define NV_MIN_EXP LDBL_MIN_EXP
+#   endif
+#   ifdef LDBL_MAX_EXP
+#       define NV_MAX_EXP LDBL_MAX_EXP
+#   endif
 #   ifdef LDBL_MIN_10_EXP
 #       define NV_MIN_10_EXP LDBL_MIN_10_EXP
 #   endif
@@ -1925,12 +1934,21 @@ EXTERN_C long double modfl(long double, long double *);
 #   ifdef DBL_MANT_DIG
 #       define NV_MANT_DIG DBL_MANT_DIG
 #   endif
+#   ifdef DBL_MANT_BITS
+#       define NV_MANT_BITS DBL_MANT_BITS
+#   endif
 #   ifdef DBL_MIN
 #       define NV_MIN DBL_MIN
 #   endif
 #   ifdef DBL_MAX
 #       define NV_MAX DBL_MAX
 #   endif
+#   ifdef DBL_MIN_EXP
+#       define NV_MIN_EXP DBL_MIN_EXP
+#   endif
+#   ifdef DBL_MAX_EXP
+#       define NV_MAX_EXP DBL_MAX_EXP
+#   endif
 #   ifdef DBL_MIN_10_EXP
 #       define NV_MIN_10_EXP DBL_MIN_10_EXP
 #   endif
index 369b587..9f1fed9 100644 (file)
@@ -2179,6 +2179,19 @@ created on an emergency basis to prevent a core dump.
 (F) The parser has given up trying to parse the program after 10 errors.
 Further error messages would likely be uninformative.
 
+=item Hexadecimal float: precision loss
+
+(W overflow) The hexadecimal floating point had internally more
+digits than could be output.  This can be caused by unsupported
+long double formats, or by 64-bit integers not being available
+(needed to retrieve the digits under some configurations).
+
+=item Hexadecimal float: unsupported long double format
+
+(F) You have configured Perl to use long doubles but
+the internals of the long double format are unknown,
+therefore the hexadecimal float output is impossible.
+
 =item Hexadecimal number > 0xffffffff non-portable
 
 (W portable) The hexadecimal number you specified is larger than 2**32-1
index b93bb32..40e4965 100644 (file)
@@ -7114,6 +7114,8 @@ In addition, Perl permits the following widely-supported conversions:
    %p    a pointer (outputs the Perl value's address in hexadecimal)
    %n    special: *stores* the number of characters output so far
          into the next argument in the parameter list
+   %a    hexadecimal floating point
+   %A    like %a, but using upper-case letters
 
 Finally, for backward (and we do mean "backward") compatibility, Perl
 permits these unnecessary but widely-supported conversions:
@@ -7128,7 +7130,9 @@ Note that the number of exponent digits in the scientific notation produced
 by C<%e>, C<%E>, C<%g> and C<%G> for numbers with the modulus of the
 exponent less than 100 is system-dependent: it may be three or less
 (zero-padded as necessary).  In other words, 1.23 times ten to the
-99th may be either "1.23e99" or "1.23e099".
+99th may be either "1.23e99" or "1.23e099".  Similarly for C<%a> and C<%A>:
+the exponent or the hexadecimal digits may float: especially the
+"long doubles" Perl configuration option may cause surprises.
 
 Between the C<%> and the format letter, you may specify several
 additional attributes controlling the interpretation of the format.
diff --git a/sv.c b/sv.c
index afd4376..c737a06 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10585,6 +10585,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     /* large enough for "%#.#f" --chip */
     /* what about long double NVs? --jhi */
     bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
+    bool hexfp = FALSE;
 
     DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED;
 
@@ -11376,6 +11377,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        case 'e': case 'E':
        case 'f':
        case 'g': case 'G':
+       case 'a': case 'A':
            if (vectorize)
                goto unknown;
 
@@ -11428,14 +11430,36 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
               else. frexp() has some unspecified behaviour for those three */
            if (c != 'e' && c != 'E' && (nv * 0) == 0) {
-               i = PERL_INT_MIN;
-               /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
-                  will cast our (long double) to (double) */
-               (void)Perl_frexp(nv, &i);
-               if (i == PERL_INT_MIN)
-                   Perl_die(aTHX_ "panic: frexp");
-               if (i > 0)
-                   need = BIT_DIGITS(i);
+                i = PERL_INT_MIN;
+                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
+                   will cast our (long double) to (double) */
+                (void)Perl_frexp(nv, &i);
+                if (i == PERL_INT_MIN)
+                    Perl_die(aTHX_ "panic: frexp");
+                hexfp = (c == 'a' || c == 'A');
+                if (UNLIKELY(hexfp)) {
+                    /* Hexadecimal floating point: this size
+                     * computation probably overshoots, but that is
+                     * better than undershooting. */
+                    need +=
+                        (nv < 0) + /* possible unary minus */
+                        2 + /* "0x" */
+                        1 + /* the very unlikely carry */
+                        1 + /* "1" */
+                        1 + /* "." */
+                        /* We want one byte per each 4 bits in the
+                         * mantissa.  This works out to about 0.83
+                         * bytes per NV decimal digit (of 4 bits):
+                         * (NV_DIG * log(10)/log(2)) / 4,
+                         * we overestimate by using 5/6 (0.8333...) */
+                        ((NV_DIG * 5) / 6 + 1) +
+                        2 + /* "p+" */
+                        (i >= 0 ? BIT_DIGITS(i) : 1 + BIT_DIGITS(-i)) +
+                        1;   /* \0 */
+                    /* XXX if PL_numeric_radix_sv && IN_LC(LC_NUMERIC) */
+                } else if (i > 0) {
+                    need = BIT_DIGITS(i);
+                } /* if i < 0, the number of digits is hard to predict. */
            }
            need += has_precis ? precis : 6; /* known default */
 
@@ -11533,7 +11557,311 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                        break;
                }
            }
-           {
+
+            if (UNLIKELY(hexfp)) {
+                /* Hexadecimal floating point. */
+                char* p = PL_efloatbuf;
+                /* vdig will contain the values (0..15) of the hex
+                 * digits ("nybbles" of 4 bits); at most 128 bits
+                 * mantissa, 4 bits per xdigit. */
+                U8 vdig[128 / 4];
+                U8* v = vdig; /* working pointer to vdig */
+                U8* vend; /* pointer to one beyond last of vdig */
+                U8* vfnz = NULL; /* first non-zero */
+                const bool lower = (c == 'a');
+                /* At output the values of vdig (up to vend) will
+                 * be mapped through the xdig to get the actual
+                 * human-readable xdigits. */
+                const char* xdig = PL_hexdigit;
+                int zerotail = 0; /* how many extra zeros to append */
+                int exponent; /* exponent of the floating point input */
+                int ix; /* working horse index */
+
+                /* If we do not have a known long double format,
+                 * (including not using long doubles, or long doubles
+                 * being equal to doubles) then we will fall back to
+                 * the ldexp/frexp route, with which we can retrieve
+                 * at most as many bits as our widest unsigned integer
+                 * type is.  We try to get a 64-bit unsigned integer
+                 * even if we are not having 64-bit UV. */
+#if UVSIZE == 8
+#  define MANTISSATYPE UV
+#  define MANTISSASIZE UVSIZE
+#elif defined(HAS_QUAD) && defined(Uquad_t)
+#  define MANTISSATYPE Uquad_t
+#  define MANTISSASIZE 8
+#else
+#  define MANTISSATYPE UV /* Will likely lose precision. */
+#  define MANTISSASIZE UVSIZE
+#endif
+
+                /* First we see if we are using long doubles. */
+
+#if NVSIZE > DOUBLESIZE && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE
+                {
+                    const U8* nvp = (const U8*)(&nv);
+                    (void)Perl_frexp(PERL_ABS(nv), &exponent);
+#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+                    /* The bytes 15..0 are the mantissa/fraction */
+                    for (ix = 15; ix >= 0; ix--) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+                    /* Used in e.g. Solaris Sparc and HP-PA HP-UX, e.g.
+                     * bf fb 99 99 99 99 99 99 99 99 99 99 99 99 99 9a */
+                    /* The bytes 0..15 are the mantissa/fraction */
+                    for (ix = 0; ix <= 15; ix++) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+                    /* x86 80-bit "extended precision", 64 bits of
+                     * mantissa/fraction/significand, 15 bits of exponent,
+                     * 1 bit of sign.  NVSIZE can be either 12 (ILP32,
+                     * Solaris x86) or 16 (LP64, Linux and OS X),
+                     * meaning that 4 or 6 bytes are empty padding. */
+                    /* The bytes 7..0 are the mantissa/fraction */
+                    for (ix = 7; ix >= 0; ix--) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+                    /* The last 10 bytes are the mantissa/fraction.
+                     * (does this format ever happen?) */
+                    for (ix = LONGDBLSIZE - 10; ix < LONGDBLSIZE; ix++) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+                    /* XXX: implement, the mantissa/fraction bits are in
+                     * two separate stretches. */
+#   define LONGDOUBLE_FALLBACK
+                    goto frexp_ldexp_fallback;
+#  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+                    /* XXX: implement, the mantissa/fraction bits are in
+                     * two separate stretches. */
+                    /* Used in e.g. PPC/Power and MIPS. */
+                    /* -0.1L:
+                     * bf b9 99 99 99 99 99 9a 3c 59 99 99 99 99 99 9a
+                     * as seen in PowerPC AIX, as opposed to "true" 128-bit
+                     * IEEE 754:
+                     * bf fb 99 99 99 99 99 99 99 99 99 99 99 99 99 9a
+                     * as seen in HP-PA HP-UX. */
+#   define LONGDOUBLE_FALLBACK
+                    goto frexp_ldexp_fallback;
+#  else
+                    Perl_croak(aTHX_
+                               "Hexadecimal float: unsupported long double format");
+#  endif
+                }
+
+#  ifdef LONGDOUBLE_FALLBACK
+            frexp_ldexp_fallback:
+#  endif
+#else
+                {
+                    /* If not using long doubles (or if the long double
+                     * format is known but not yet supported), try to
+                     * retrieve the mantissa bits via frexp+ldexp. */
+
+                    MANTISSATYPE mantissa =
+                        Perl_ldexp(Perl_frexp(PERL_ABS(nv), &exponent),
+                                   NV_MANT_DIG);
+                    const U8* nvp = (const U8*)(&mantissa);
+                    /* Theoretically we have all the bytes [0, UVSIZE - 1]
+                     * to inspect; but in practice we don't want the
+                     * leading nybbles that are zero.  With the common
+                     * IEEE 754 value for NV_MANT_DIG being 53, we want
+                     * the limit byte to be (int)((52-1)/8) == 6.
+                     *
+                     * Note that this is _not_ inspecting the in-memory
+                     * format of the nv (as opposed to the long double
+                     * method), but instead the UV retrieved with the
+                     * frexp+ldexp invocation. */
+                    int limit_byte = (NV_MANT_DIG - 1) / 8;
+                    /* We make here the wild assumption that
+                     * the endianness of doubles is similar to
+                     * the endianness of integers, and that
+                     * there is no middle-endianness.  This may
+                     * come back to haunt us (the rumor has it
+                     * that ARM can be quite haunted).
+                     *
+                     * We generate 4-bit xdigits (nybble/nibble)
+                     * instead of 8-bit bytes, since we might need
+                     * to handle printf precision, and also insert
+                     * the decimal point.
+                     */
+#  if BYTEORDER == 0x12345678 || BYTEORDER == 0x1234 || \
+     LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
+     LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+     LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+                    /* Little endian. */
+                    for (ix = limit_byte; ix >= 0; ix--) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  else
+                    /* Big endian. */
+                    for (ix = 0; ix <= limit_byte; ix++) {
+                        *v++ = nvp[ix] >> 4;
+                        *v++ = nvp[ix] & 0xF;
+                    }
+#  endif
+                    /* If there are not enough bits in MANTISSATYPE,
+                     * we couldn't get all of them.
+                     *
+                     * Note that NV_PRESERVES_UV_BITS would not help
+                     * here, it is the wrong way around. */
+#  if NV_MANT_DIG > MANTISSASIZE * 8
+                    Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                                   "Hexadecimal float: precision loss");
+#  endif
+                }
+#endif
+                vend = v;
+                assert(vend > vdig);
+                assert(vend < vdig + sizeof(vdig));
+
+                if (nv < 0)
+                    *p++ = '-';
+                else if (plus)
+                    *p++ = plus;
+                *p++ = '0';
+                if (lower) {
+                    *p++ = 'x';
+                }
+                else {
+                    *p++ = 'X';
+                    xdig += 16; /* Use uppercase hex. */
+                }
+
+                /* Find the first non-zero xdigit. */
+                for (v = vdig; v < vend; v++) {
+                    if (*v) {
+                        vfnz = v;
+                        break;
+                    }
+                }
+
+                if (vfnz) {
+                    U8* vlnz = NULL; /* The last non-zero. */
+
+                    /* Find the last non-zero xdigit. */
+                    for (v = vend - 1; v >= vdig; v--) {
+                        if (*v) {
+                            vlnz = v;
+                            break;
+                        }
+                    }
+
+                    /* Adjust the exponent so that the first output
+                     * xdigit aligns with the 4-bit nybbles. */
+                    exponent -= NV_MANT_DIG % 4 ? NV_MANT_DIG % 4 : 4;
+
+                    if (precis > 0) {
+                        v = vdig + precis + 1;
+                        if (v < vend) {
+                            /* Round away from zero: if the tail
+                             * beyond the precis xdigits is equal to
+                             * or greater than 0x8000... */
+                            bool round = *v > 0x8;
+                            if (!round && *v == 0x8) {
+                                for (v++; v < vend; v++) {
+                                    if (*v) {
+                                        round = TRUE;
+                                        break;
+                                    }
+                                }
+                            }
+                            if (round) {
+                                for (v = vdig + precis; v >= vdig; v--) {
+                                    if (*v < 0xF) {
+                                        (*v)++;
+                                        break;
+                                    }
+                                    *v = 0;
+                                    if (v == vdig) {
+                                        /* If the carry goes all the way to
+                                         * the front, we need to output
+                                         * a single '1'. This goes against
+                                         * the "xdigit and then decimal point"
+                                         * but since this is "cannot happen"
+                                         * category, that is probably good. */
+                                        *p++ = xdig[1];
+                                    }
+                                }
+                            }
+                            /* The new effective "last non zero". */
+                            vlnz = vdig + precis;
+                        }
+                        else {
+                            zerotail = precis - (vlnz - vdig);
+                        }
+                    }
+
+                    v = vdig;
+                    *p++ = xdig[*v++];
+
+                    /* The decimal point is always output after
+                     * the first non-zero xdigit, or if alt.  */
+                    /* XXX if PL_numeric_radix_sv && IN_LC(LC_NUMERIC) */
+                    if (vfnz < vlnz || alt) {
+#ifndef USE_LOCALE_NUMERIC
+                        *p++ = '.';
+#else
+                        STORE_LC_NUMERIC_SET_TO_NEEDED();
+                        if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+                            STRLEN n;
+                            const char* r = SvPV(PL_numeric_radix_sv, n);
+                            Copy(r, p, n, char);
+                            p += n;
+                        }
+                        else {
+                            *p++ = '.';
+                        }
+                        RESTORE_LC_NUMERIC();
+#endif
+                    }
+
+                    while (v <= vlnz)
+                        *p++ = xdig[*v++];
+
+                    while (zerotail--)
+                        *p++ = '0';
+                } else {
+                    *p++ = '0';
+                    exponent = 0;
+                }
+
+                elen = p - PL_efloatbuf;
+                elen += my_snprintf(p, PL_efloatsize - elen,
+                                    "%c%+d", lower ? 'p' : 'P',
+                                    exponent);
+
+                if (elen < width) {
+                    if (left) {
+                        /* Pad the back with spaces. */
+                        memset(PL_efloatbuf + elen, ' ', width - elen);
+                    } else if (fill == '0') {
+                        /* Insert the zeros between the "0x" and
+                         * the digits, otherwise we end up with
+                         * "0000xHHH..." */
+                        STRLEN nzero = width - elen;
+                        char* zerox = PL_efloatbuf + 2;
+                        Move(zerox, zerox + nzero,  elen - 2, char);
+                        memset(zerox, fill, nzero);
+                    } else {
+                        /* Move it to the right. */
+                        Move(PL_efloatbuf, PL_efloatbuf + width - elen,
+                             elen, char);
+                        /* Pad the front with spaces. */
+                        memset(PL_efloatbuf, ' ', width - elen);
+                    }
+                    elen = width;
+                }
+            }
+            else {
                char *ptr = ebuf + sizeof ebuf;
                *--ptr = '\0';
                *--ptr = c;
@@ -11577,14 +11905,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                  * that is safe to use, even though it's not literal */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
 #if defined(HAS_LONG_DOUBLE)
-               elen = ((intsize == 'q')
-                       ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
-                       : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
+                elen = ((intsize == 'q')
+                        ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+                        : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
 #else
-               elen = my_sprintf(PL_efloatbuf, ptr, nv);
+                elen = my_sprintf(PL_efloatbuf, ptr, nv);
 #endif
                 GCC_DIAG_RESTORE;
            }
+
        float_converted:
            eptr = PL_efloatbuf;
 
index 4c41b16..74bf130 100644 (file)
@@ -179,7 +179,7 @@ __END__
 >%6. 6s<    >''<          >%6. 6s INVALID REDUNDANT< >(See use of $w in code above)<
 >%6 .6s<    >''<          >%6 .6s INVALID REDUNDANT<
 >%6.6 s<    >''<          >%6.6 s INVALID REDUNDANT<
->%A<        >''<          >%A INVALID REDUNDANT<
+>%A<        >0<           ><    >%A tested in sprintf2.t skip: all<
 >%B<        >2**32-1<     >11111111111111111111111111111111<
 >%+B<       >2**32-1<     >11111111111111111111111111111111<
 >%#B<       >2**32-1<     >0B11111111111111111111111111111111<
@@ -213,7 +213,7 @@ __END__
 >%#X<       >2**32-1<     >0XFFFFFFFF<
 >%Y<        >''<          >%Y INVALID REDUNDANT<
 >%Z<        >''<          >%Z INVALID REDUNDANT<
->%a<        >''<          >%a INVALID REDUNDANT<
+>%a<        >0<           ><    >%a tested in sprintf2.t skip: all<
 >%b<        >2**32-1<     >11111111111111111111111111111111<
 >%+b<       >2**32-1<     >11111111111111111111111111111111<
 >%#b<       >2**32-1<     >0b11111111111111111111111111111111<
index 6fd0bde..311593d 100644 (file)
@@ -12,7 +12,117 @@ BEGIN {
 eval { my $q = pack "q", 0 };
 my $Q = $@ eq '';
 
-plan tests => 1406 + ($Q ? 0 : 12);
+# %a and %A depend on the floating point config
+# This totally doesn't test non-IEEE-754 float formats.
+my @hexfloat;
+print "# uvsize = $Config{uvsize}\n";
+print "# nvsize = $Config{nvsize}\n";
+print "# nv_preserves_uv_bits = $Config{nv_preserves_uv_bits}\n";
+print "# d_quad = $Config{d_quad}\n";
+if ($Config{nvsize} == 8 &&
+    (
+     # IEEE-754, we hope, the most common out there.
+     ($Config{uvsize} == 8 && $Config{nv_preserves_uv_bits} == 53)
+     ||
+     # If we have a quad we get still get the mantissa bits.
+     ($Config{uvsize} == 4&&  $Config{d_quad})
+     )
+    ) {
+    @hexfloat =  (
+        [ '%a',       '0',       '0x0p+0' ],
+        [ '%a',       '1',       '0x1p+0' ],
+        [ '%a',       '1.0',     '0x1p+0' ],
+        [ '%a',       '0.5',     '0x1p-1' ],
+        [ '%a',       '0.25',    '0x1p-2' ],
+        [ '%a',       '0.75',    '0x1.8p-1' ],
+        [ '%a',       '3.14',    '0x1.91eb851eb851fp+1' ],
+        [ '%a',       '-1.0',    '-0x1p+0' ],
+        [ '%a',       '-3.14',   '-0x1.91eb851eb851fp+1' ],
+        [ '%a',       '0.1',     '0x1.999999999999ap-4' ],
+        [ '%a',       '1/7',     '0x1.2492492492492p-3' ],
+        [ '%a',       'sqrt(2)', '0x1.6a09e667f3bcdp+0' ],
+        [ '%a',       'exp(1)',  '0x1.5bf0a8b145769p+1' ],
+        [ '%a',       '2**-10',  '0x1p-10' ],
+        [ '%a',       '2**10',   '0x1p+10' ],
+        [ '%a',       '1e-9',    '0x1.12e0be826d695p-30' ],
+        [ '%a',       '1e9',     '0x1.dcd65p+29' ],
+
+        [ '%#a',      '1',       '0x1.p+0' ],
+        [ '%+a',      '1',       '+0x1p+0' ],
+        [ '%+a',      '-1',      '-0x1p+0' ],
+        [ '% a',      ' 1',      ' 0x1p+0' ],
+        [ '% a',      '-1',      '-0x1p+0' ],
+
+        [ '%8a',      '3.14',   '0x1.91eb851eb851fp+1' ],
+        [ '%13a',     '3.14',   '0x1.91eb851eb851fp+1' ],
+        [ '%20a',     '3.14',   '0x1.91eb851eb851fp+1' ],
+        [ '%.4a',     '3.14',   '0x1.91ecp+1' ],
+        [ '%.5a',     '3.14',   '0x1.91eb8p+1' ],
+        [ '%.6a',     '3.14',   '0x1.91eb85p+1' ],
+        [ '%.20a',    '3.14',   '0x1.91eb851eb851f0000000p+1' ],
+        [ '%20.10a',  '3.14',   '   0x1.91eb851eb8p+1' ],
+        [ '%20.15a',  '3.14',   '0x1.91eb851eb851f00p+1' ],
+        [ '% 20.10a', '3.14',   '   0x1.91eb851eb8p+1' ],
+        [ '%020.10a', '3.14',   '0x0001.91eb851eb8p+1' ],
+
+        [ '%30a',  '3.14',   '          0x1.91eb851eb851fp+1' ],
+        [ '%-30a', '3.14',   '0x1.91eb851eb851fp+1          ' ],
+        [ '%030a',  '3.14',  '0x00000000001.91eb851eb851fp+1' ],
+        [ '%-030a', '3.14',  '0x1.91eb851eb851fp+1          ' ],
+
+        [ '%A',       '3.14',   '0X1.91EB851EB851FP+1' ],
+        );
+} elsif ($Config{nvsize} == 16 || $Config{nvsize} == 12) {
+    # x86 long double, at least
+    @hexfloat =  (
+        [ '%a',       '0',       '0x0p+0' ],
+        [ '%a',       '1',       '0x8p-3' ],
+        [ '%a',       '1.0',     '0x8p-3' ],
+        [ '%a',       '0.5',     '0x8p-4' ],
+        [ '%a',       '0.25',    '0x8p-5' ],
+        [ '%a',       '0.75',    '0xcp-4' ],
+        [ '%a',       '3.14',    '0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%a',       '-1.0',    '-0x8p-3' ],
+        [ '%a',       '-3.14',   '-0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%a',       '0.1',     '0xc.ccccccccccccccdp-7' ],
+        [ '%a',       '1/7',     '0x9.249249249249249p-6' ],
+        [ '%a',       'sqrt(2)', '0xb.504f333f9de6484p-3' ],
+        [ '%a',       'exp(1)',  '0xa.df85458a2bb4a9bp-2' ],
+        [ '%a',       '2**-10',  '0x8p-13' ],
+        [ '%a',       '2**10',   '0x8p+7' ],
+        [ '%a',       '1e-9',    '0x8.9705f4136b4a597p-33' ],
+        [ '%a',       '1e9',     '0xe.e6b28p+26' ],
+
+        [ '%#a',      '1',       '0x8.p-3' ],
+        [ '%+a',      '1',       '+0x8p-3' ],
+        [ '%+a',      '-1',      '-0x8p-3' ],
+        [ '% a',      ' 1',      ' 0x8p-3' ],
+        [ '% a',      '-1',      '-0x8p-3' ],
+
+        [ '%8a',      '3.14',    '0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%13a',     '3.14',    '0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%20a',     '3.14',    '0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%.4a',     '3.14',    '0xc.8f5cp-2' ],
+        [ '%.5a',     '3.14',    '0xc.8f5c3p-2' ],
+        [ '%.6a',     '3.14',    '0xc.8f5c29p-2' ],
+        [ '%.20a',    '3.14',    '0xc.8f5c28f5c28f5c300000p-2' ],
+        [ '%20.10a',  '3.14',    '   0xc.8f5c28f5c3p-2' ],
+        [ '%20.15a',  '3.14',    '0xc.8f5c28f5c28f5c3p-2' ],
+        [ '% 20.10a', '3.14',    '   0xc.8f5c28f5c3p-2' ],
+        [ '%020.10a', '3.14',    '0x000c.8f5c28f5c3p-2' ],
+
+        [ '%30a',  '3.14',   '        0xc.8f5c28f5c28f5c3p-2' ],
+        [ '%-30a', '3.14',   '0xc.8f5c28f5c28f5c3p-2        ' ],
+        [ '%030a',  '3.14',  '0x00000000c.8f5c28f5c28f5c3p-2' ],
+        [ '%-030a', '3.14',  '0xc.8f5c28f5c28f5c3p-2        ' ],
+
+        [ '%A',       '3.14',    '0XC.8F5C28F5C28F5C3P-2' ],
+        );
+} else {
+    print "# no hexfloat tests\n";
+}
+
+plan tests => 1406 + ($Q ? 0 : 12) + @hexfloat;
 
 use strict;
 use Config;
@@ -336,3 +446,10 @@ is $o::count, '1', 'sprinf %1s overload count';
 $o::count = 0;
 () = sprintf "%.1s", $o;
 is $o::count, '1', 'sprinf %.1s overload count';
+
+for my $t (@hexfloat) {
+    my ($format, $arg, $expected) = @$t;
+    $arg = eval $arg;
+    my $result = sprintf($format, $arg);
+    is($result, $expected, "'$format' '$arg' -> '$result' cf '$expected'");
+}