diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 9ee0f7125853..e331bb18a1ea 100644 --- a/ext/XS-APItest/APItest.pm +++ b/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; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index c4f7d4462593..0b2fc46e4583 100644 --- a/ext/XS-APItest/APItest.xs +++ b/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 diff --git a/ext/XS-APItest/t/printf.t b/ext/XS-APItest/t/printf.t index 28f21e35e17d..927802377f96 100644 --- a/ext/XS-APItest/t/printf.t +++ b/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"); } { diff --git a/sv.c b/sv.c index e54d0a078fa1..b1a95a80ca21 100644 --- a/sv.c +++ b/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,