This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
clean up quadmath_format_*() functions
authorTony Cook <tony@develop-help.com>
Mon, 11 Nov 2019 22:11:34 +0000 (09:11 +1100)
committerKarl Williamson <khw@cpan.org>
Sun, 17 Nov 2019 00:07:35 +0000 (16:07 -0800)
This includes:

- remove them from the API

- simplify quadmath_format_single()'s interface, and rename it
  to match the new interface

fixes #17288

embed.fnc
embed.h
pp_ctl.c
proto.h
sv.c
util.c

index 8e429eb..5579dee 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -3314,8 +3314,8 @@ XEopxR    |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \
 AMpTdf |int    |my_snprintf    |NN char *buffer|const Size_t len|NN const char *format|...
 AMpTd  |int    |my_vsnprintf   |NN char *buffer|const Size_t len|NN const char *format|va_list ap
 #ifdef USE_QUADMATH
-ApTd   |const char*    |quadmath_format_single|NN const char* format
-ApTd   |bool|quadmath_format_needed|NN const char* format
+pTd    |bool   |quadmath_format_valid|NN const char* format
+pTd    |bool|quadmath_format_needed|NN const char* format
 #endif
 
 : Used in mg.c, sv.c
diff --git a/embed.h b/embed.h
index 6351956..2f98e7b 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define PerlIO_unread(a,b,c)   Perl_PerlIO_unread(aTHX_ a,b,c)
 #define PerlIO_write(a,b,c)    Perl_PerlIO_write(aTHX_ a,b,c)
 #endif
-#if defined(USE_QUADMATH)
-#define quadmath_format_needed Perl_quadmath_format_needed
-#define quadmath_format_single Perl_quadmath_format_single
-#endif
 #if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
 #define do_aspawn(a,b,c)       Perl_do_aspawn(aTHX_ a,b,c)
 #define do_spawn(a)            Perl_do_spawn(aTHX_ a)
 #define PerlIO_restore_errno(a)        Perl_PerlIO_restore_errno(aTHX_ a)
 #define PerlIO_save_errno(a)   Perl_PerlIO_save_errno(aTHX_ a)
 #  endif
+#  if defined(USE_QUADMATH)
+#define quadmath_format_needed Perl_quadmath_format_needed
+#define quadmath_format_valid  Perl_quadmath_format_valid
+#  endif
 #  if defined(_MSC_VER)
 #define magic_regdatum_set(a,b)        Perl_magic_regdatum_set(aTHX_ a,b)
 #  endif
index ec08078..3253851 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -881,15 +881,12 @@ PP(pp_formline)
                 arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
 #ifdef USE_QUADMATH
                 {
-                    const char* qfmt = quadmath_format_single(fmt);
                     int len;
-                    if (!qfmt)
+                    if (!quadmath_format_valid(fmt))
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", fmt);
-                    len = quadmath_snprintf(t, max, qfmt, (int) fieldsize, (int) arg, value);
+                    len = quadmath_snprintf(t, max, fmt, (int) fieldsize, (int) arg, value);
                     if (len == -1)
-                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
-                    if (qfmt != fmt)
-                        Safefree(fmt);
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", fmt);
                 }
 #else
                 /* we generate fmt ourselves so it is safe */
diff --git a/proto.h b/proto.h
index 3278c9b..251ef12 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6670,8 +6670,8 @@ PERL_CALLCONV SSize_t     Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_
 PERL_CALLCONV bool     Perl_quadmath_format_needed(const char* format);
 #define PERL_ARGS_ASSERT_QUADMATH_FORMAT_NEEDED        \
        assert(format)
-PERL_CALLCONV const char*      Perl_quadmath_format_single(const char* format);
-#define PERL_ARGS_ASSERT_QUADMATH_FORMAT_SINGLE        \
+PERL_CALLCONV bool     Perl_quadmath_format_valid(const char* format);
+#define PERL_ARGS_ASSERT_QUADMATH_FORMAT_VALID \
        assert(format)
 #endif
 #if defined(WIN32)
diff --git a/sv.c b/sv.c
index 69ff0d7..485755b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13195,20 +13195,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
 #ifdef USE_QUADMATH
                 {
-                    const char* qfmt = quadmath_format_single(ptr);
-                    if (!qfmt)
+                    if (!quadmath_format_valid(ptr))
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
                     WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
                         elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
-                                                 qfmt, nv);
+                                                 ptr, nv);
                     );
                     if ((IV)elen == -1) {
-                        if (qfmt != ptr)
-                            SAVEFREEPV(qfmt);
-                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", ptr);
                     }
-                    if (qfmt != ptr)
-                        Safefree(qfmt);
                 }
 #elif defined(HAS_LONG_DOUBLE)
                 WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric,
diff --git a/util.c b/util.c
index caba9f0..dc49d0e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4912,51 +4912,40 @@ Perl_mem_log_del_sv(const SV *sv,
 #endif /* PERL_MEM_LOG */
 
 /*
-=for apidoc quadmath_format_single
+=for apidoc quadmath_format_valid
 
 C<quadmath_snprintf()> is very strict about its C<format> string and will
 fail, returning -1, if the format is invalid.  It accepts exactly
 one format spec.
 
-C<quadmath_format_single()> checks that the intended single spec looks
+C<quadmath_format_valid()> checks that the intended single spec looks
 sane: begins with C<%>, has only one C<%>, ends with C<[efgaEFGA]>,
 and has C<Q> before it.  This is not a full "printf syntax check",
 just the basics.
 
-Returns the format if it is valid, NULL if not.
-
-C<quadmath_format_single()> can and will actually patch in the missing
-C<Q>, if necessary.  In this case it will return the modified copy of
-the format, B<which the caller will need to free.>
+Returns true if it is valid, false if not.
 
 See also L</quadmath_format_needed>.
 
 =cut
 */
 #ifdef USE_QUADMATH
-const char*
-Perl_quadmath_format_single(const char* format)
+bool
+Perl_quadmath_format_valid(const char* format)
 {
     STRLEN len;
 
-    PERL_ARGS_ASSERT_QUADMATH_FORMAT_SINGLE;
+    PERL_ARGS_ASSERT_QUADMATH_FORMAT_VALID;
 
     if (format[0] != '%' || strchr(format + 1, '%'))
-        return NULL;
+        return FALSE;
     len = strlen(format);
     /* minimum length three: %Qg */
     if (len < 3 || strchr("efgaEFGA", format[len - 1]) == NULL)
-        return NULL;
-    if (format[len - 2] != 'Q') {
-        char* fixed;
-        Newx(fixed, len + 2, char);
-        memcpy(fixed, format, len - 1);
-        fixed[len - 1] = 'Q';
-        fixed[len    ] = format[len - 1];
-        fixed[len + 1] = 0;
-        return (const char*)fixed;
-    }
-    return format;
+        return FALSE;
+    if (format[len - 2] != 'Q')
+        return FALSE;
+    return TRUE;
 }
 #endif
 
@@ -4972,7 +4961,7 @@ but it should catch most common cases.
 
 If true is returned, those arguments B<should> in theory be processed
 with C<quadmath_snprintf()>, but in case there is more than one such
-format specifier (see L</quadmath_format_single>), and if there is
+format specifier (see L</quadmath_format_valid>), and if there is
 anything else beyond that one (even just a single byte), they
 B<cannot> be processed because C<quadmath_snprintf()> is very strict,
 accepting only one format spec, and nothing else.
@@ -5041,24 +5030,15 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
     va_start(ap, format);
 #ifdef USE_QUADMATH
     {
-        const char* qfmt = quadmath_format_single(format);
         bool quadmath_valid = FALSE;
-        if (qfmt) {
+        if (quadmath_format_valid(format)) {
             /* If the format looked promising, use it as quadmath. */
-            retval = quadmath_snprintf(buffer, len, qfmt, va_arg(ap, NV));
+            retval = quadmath_snprintf(buffer, len, format, va_arg(ap, NV));
             if (retval == -1) {
-                if (qfmt != format) {
-                    dTHX;
-                    SAVEFREEPV(qfmt);
-                }
-                Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+                Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", format);
             }
             quadmath_valid = TRUE;
-            if (qfmt != format)
-                Safefree(qfmt);
-            qfmt = NULL;
         }
-        assert(qfmt == NULL);
         /* quadmath_format_single() will return false for example for
          * "foo = %g", or simply "%g".  We could handle the %g by
          * using quadmath for the NV args.  More complex cases of