Create Strtod()

This commit creates my_strod() and a synonym, Strtod(), to emulate
strtod() using the most precise function known to us that is available
on the platform.  strtod() is not in K&R, but is in C90, so atof() may
be silently substituted instead on those few platforms without it.

This function also correctly handles locale issues, such as if the radix
character should be a dot or comma (or something else) depending on the
parent perl code is using locale or not, and which locale.

The symbol Perl_strtod continues to be defined on platforms which have
some version of strtod(), for backward compatibility, and can be called
as a function (or rather macro) but most applications should just use
Strtod() and not sweat the details.

This commit also fixes the problems with the prior commit:
    commit 4ac6fab20b8950ee14756c6f2438809c572082cd
     Author: Karl Williamson <khw@cpan.org>
     Date:   Mon Apr 15 11:10:31 2019 -0600

         PATCH: [perl #133945] Perl_strtod failures

         This commit wraps Perl_strtod() in macros that cause the proper
         radix character to be used.

6 files changed, 120 insertions, 33 deletions

diff --git a/embed.fnc b/embed.fnc
index ef30f5b627..45597f67b6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1110,6 +1110,7 @@ s	|void	|move_proto_attr|NN OP **proto|NN OP **attrs \
 p	|int	|mode_from_discipline|NULLOK const char* s|STRLEN len
 Ap	|const char*	|moreswitches	|NN const char* s
 Ap	|NV	|my_atof	|NN const char *s
+AnpR	|NV	|my_strtod	|NN const char * const s|NULLOK char ** e
 Apr	|void	|my_exit	|U32 status
 Apr	|void	|my_failure_exit
 Ap	|I32	|my_fflush_all
diff --git a/embed.h b/embed.h
index 930a44ab1e..75c91f77f4 100644
--- a/embed.h
+++ b/embed.h
@@ -490,6 +490,7 @@
 #define my_setenv(a,b)		Perl_my_setenv(aTHX_ a,b)
 #define my_socketpair		Perl_my_socketpair
 #define my_strftime(a,b,c,d,e,f,g,h,i,j)	Perl_my_strftime(aTHX_ a,b,c,d,e,f,g,h,i,j)
+#define my_strtod		Perl_my_strtod
 #define newANONATTRSUB(a,b,c,d)	Perl_newANONATTRSUB(aTHX_ a,b,c,d)
 #define newANONHASH(a)		Perl_newANONHASH(aTHX_ a)
 #define newANONLIST(a)		Perl_newANONLIST(aTHX_ a)
diff --git a/numeric.c b/numeric.c
index 9ccb808a4a..d4e3493784 100644
--- a/numeric.c
+++ b/numeric.c
@@ -29,6 +29,105 @@ values, including such things as replacements for the OS's atof() function
 #define PERL_IN_NUMERIC_C
 #include "perl.h"
 
+#ifdef Perl_strtod
+
+PERL_STATIC_INLINE NV
+S_strtod(pTHX_ const char * const s, char ** e)
+{
+    DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+    NV result;
+
+    STORE_LC_NUMERIC_SET_TO_NEEDED();
+
+#  ifdef USE_QUADMATH
+
+    result = strtoflt128(s, e);
+
+#  elif defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE)    \
+                             && defined(USE_LONG_DOUBLE)
+#    if defined(__MINGW64_VERSION_MAJOR)
+      /***********************************************
+       We are unable to use strtold because of
+        https://sourceforge.net/p/mingw-w64/bugs/711/
+        &
+        https://sourceforge.net/p/mingw-w64/bugs/725/
+
+       but __mingw_strtold is fine.
+      ***********************************************/
+
+    result = __mingw_strtold(s, e);
+
+#    else
+
+    result = strtold(s, e);
+
+#    endif
+#  elif defined(HAS_STRTOD)
+
+    result = strtod(s, e);
+
+#  endif
+
+    RESTORE_LC_NUMERIC();
+
+    return result;
+}
+
+#endif  /* #ifdef Perl_strtod */
+
+/*
+
+=for apidoc my_strtod
+
+This function is equivalent to the libc strtod() function, and is available
+even on platforms that lack plain strtod().  Its return value is the best
+available precision depending on platform capabilities and F<Configure>
+options.
+
+It properly handles the locale radix character, meaning it expects a dot except
+when called from within the scope of S<C<use locale>>, in which case the radix
+character should be that specified by the current locale.
+
+The synonym Strod() may be used instead.
+
+=cut
+
+*/
+
+NV
+my_strtod(const char * const s, char **e)
+{
+    dTHX;
+
+    PERL_ARGS_ASSERT_MY_STRTOD;
+
+#ifdef Perl_strtod
+
+    return S_strtod(aTHX_ s, e);
+
+#else
+
+    {
+        NV result;
+        char ** end_ptr = NULL;
+
+        *end_ptr = my_atof2(s, &result);
+        if (e) {
+            *e = *end_ptr;
+        }
+
+        if (! *end_ptr) {
+            result = 0.0;
+        }
+
+        return result;
+    }
+
+#endif
+
+}
+
+
 U32
 Perl_cast_ulong(NV f)
 {
@@ -1354,7 +1453,7 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
             }
 #endif
             assert(strNE(fake, "silence compiler warning"));
-            nv = Perl_strtod(fake, &endp);
+            nv = S_strtod(aTHX_ fake, &endp);
             if (fake != endp) {
 #ifdef NV_INF
                 if ((infnan & IS_NUMBER_INFINITY)) {
@@ -1460,7 +1559,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
             s = copy + (s - orig);
         }
 
-        result[2] = Perl_strtod(s, &endp);
+        result[2] = S_strtod(aTHX_ s, &endp);
 
         /* If we created a copy, 'endp' is in terms of that.  Convert back to
          * the original */
diff --git a/perl.h b/perl.h
index 9c5e9a3421..dff4b528ab 100644
--- a/perl.h
+++ b/perl.h
@@ -6528,37 +6528,13 @@ expression, but with an empty argument list, like this:
 #endif /* !USE_LOCALE_NUMERIC */
 
 #define Atof				my_atof
+#define Strtod                          my_strtod
 
-/* These are wrapped just below to handle locale */
-#ifdef USE_QUADMATH
-#  define _Perl_strtod(s, e) strtoflt128(s, e)
-#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-#  if defined(__MINGW64_VERSION_MAJOR) && defined(HAS_STRTOLD)
-      /***********************************************
-       We are unable to use strtold because of
-        https://sourceforge.net/p/mingw-w64/bugs/711/
-        &
-        https://sourceforge.net/p/mingw-w64/bugs/725/
-
-       but __mingw_strtold is fine.
-      ***********************************************/
-#    define _Perl_strtod(s, e) __mingw_strtold(s, e)
-#  elif defined(HAS_STRTOLD)
-#    define _Perl_strtod(s, e) strtold(s, e)
-#  elif defined(HAS_STRTOD)
-#    define _Perl_strtod(s, e) (NV)strtod(s, e) /* Unavoidable loss. */
-#  endif
-#elif defined(HAS_STRTOD)
-#  define _Perl_strtod(s, e) strtod(s, e)
-#endif
-
-#define Perl_strotod(s, e)                                              \
-    STMT_START {                                                        \
-        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;                        \
-        STORE_LC_NUMERIC_SET_TO_NEEDED();                               \
-        _Perl_strtod(s,e)                                               \
-        RESTORE_LC_NUMERIC();                                           \
-    } STMT_END
+#if    defined(HAS_STRTOD) || defined(USE_QUADMATH)                 \
+    || defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE)             \
+                            && defined(USE_LONG_DOUBLE)
+#  define Perl_strtod   Strtod
+#endif
 
 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \
 	(QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index fde7fddd01..bfd4b49e9a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -365,7 +365,12 @@ well.
 
 =item *
 
-XXX
+A new function L<perlapi/C<my_strtod>> or its synonym, Strtod(), is
+now availabe with the same signature as the libc strtod().  It provides
+strotod() equivalent behavior on all platforms, using the best available
+precision, depending on platform capabilities and F<Configure> options,
+while handling locale-related issues, such as if the radix character
+should be a dot or comma.
 
 =back
 
diff --git a/proto.h b/proto.h
index 63f53cddec..0f8feed187 100644
--- a/proto.h
+++ b/proto.h
@@ -2295,6 +2295,11 @@ PERL_CALLCONV char *	Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, i
 #define PERL_ARGS_ASSERT_MY_STRFTIME	\
 	assert(fmt)
 
+PERL_CALLCONV NV	Perl_my_strtod(const char * const s, char ** e)
+			__attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_MY_STRTOD	\
+	assert(s)
+
 PERL_CALLCONV void	Perl_my_unexec(pTHX);
 PERL_CALLCONV int	Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap);
 #define PERL_ARGS_ASSERT_MY_VSNPRINTF	\