quadmath: handle long doubles supplied via va_args in sv_vcatpvfn_fla…

…gs()

All of perl's printf() style processing meets up in sv_vcatpvfn_flags()
which had three problems when dealing with long double parameters.

1) both the long double (L and q) and __float128 flags (Q) were
converted to the internal long double flag

2) the internal long double flag was then always treated as a __float128
parameter.

3) the non-Q format string was then passed to my_snprintf(), which
throws an exception on non-Q floating point formats, which meant that
C/XS code printing doubles or long doubles in a quadmath built would
throw an exception.

ext/XS-APItest/APItest.pm

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '1.15';
+our $VERSION = '1.16';
 
 require XSLoader;
 

ext/XS-APItest/APItest.xs

@@ -2355,6 +2355,18 @@ print_long_double()
 #   endif
 #endif
 
+void
+print_long_doubleL()
+        CODE:
+#ifdef HAS_LONG_DOUBLE
+        /* used to test we allow the length modifier required by the standard */
+        long double val = 7.0;
+        printf("%5.3Lf\n",val);
+#else
+        double val = 7.0;
+        printf("%5.3f\n",val);
+#endif
+
 void
 print_int(val)
         int val

ext/XS-APItest/t/printf.t

@@ -1,12 +1,4 @@
-BEGIN {
-  require Config; import Config;
-  if ($Config{usequadmath}) {
-     print "1..0 # Skip: usequadmath\n";
-     exit(0);
-  }
-}
-
-use Test::More tests => 12;
+use Test::More tests => 13;
 
 BEGIN { use_ok('XS::APItest') };
 
@@ -29,6 +21,7 @@ print_int(3);
 print_long(4);
 print_float(4);
 print_long_double() if $ldok;  # val=7 hardwired
+print_long_doubleL() if $ldok;  # val=7 hardwired
 
 print_flush();
 
@@ -47,8 +40,9 @@ is($output[2], "4", "print_long");
 is($output[3], "4.000", "print_float");
 
 SKIP: {
-   skip "No long doubles", 1 unless $ldok;
+   skip "No long doubles", 2 unless $ldok;
    is($output[4], "7.000", "print_long_double");
+   is($output[5], "7.000", "print_long_doubleL");
 }
 
 {

sv.c

@@ -12288,10 +12288,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     (IVSIZE == 4 && !defined(HAS_LONG_DOUBLE))
 	case 'L':			/* Ld */
 	    /* FALLTHROUGH */
-#  ifdef USE_QUADMATH
-        case 'Q':
-	    /* FALLTHROUGH */
-#  endif
 #  if IVSIZE >= 8
 	case 'q':			/* qd */
 #  endif
@@ -12319,6 +12315,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 	    else
 		intsize = 'h';
 	    break;
+#ifdef USE_QUADMATH
+        case 'Q':
+#endif
 	case 'V':
 	case 'z':
 	case 't':
@@ -12840,6 +12839,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 	       for simplicity we allow any of %Lf, %llf, %qf for long double
 	    */
 	    switch (intsize) {
+#if defined(USE_QUADMATH)
+            case 'Q':
+                break;
+#endif
 	    case 'V':
 #if defined(USE_LONG_DOUBLE) || defined(USE_QUADMATH)
 		intsize = 'q';
@@ -12879,9 +12882,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                  * is when the format specifier explicitly asks so with
                  * e.g. "%Lg". */
 #ifdef USE_QUADMATH
-                fv = intsize == 'q' ?
-                    va_arg(*args, NV) : va_arg(*args, double);
-                nv = fv;
+                nv = intsize == 'Q' ? va_arg(*args, NV) :
+                    intsize == 'q' ? va_arg(*args, long double) :
+                    va_arg(*args, double);
+                fv = nv;
 #elif LONG_DOUBLESIZE > DOUBLESIZE
                 if (intsize == 'q') {
                     fv = va_arg(*args, long double);
@@ -13141,10 +13145,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 *--ptr = '\0';
                 *--ptr = c;
 #if defined(USE_QUADMATH)
-		if (intsize == 'q') {
-                    /* "g" -> "Qg" */
-                    *--ptr = 'Q';
-                }
+                /* always use Q here.  my_snprint() throws an exception if we
+                   fallthrough to the double/long double code, even when the
+                   format is correct, presumably to avoid any accidentally
+                   missing Q.
+                */
+                *--ptr = 'Q';
                 /* FIXME: what to do if HAS_LONG_DOUBLE but not PERL_PRIfldbl? */
 #elif defined(HAS_LONG_DOUBLE) && defined(PERL_PRIfldbl)
 		/* Note that this is HAS_LONG_DOUBLE and PERL_PRIfldbl,