pod/perlpod: Add advice about Z<> uses

[perl5.git] / perl.h

diff --git a/perl.h b/perl.h
index df2fc1a..06f62b1 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -623,16 +623,24 @@
 #   define TAINT_WARN_get       0
 #   define TAINT_WARN_set(s)    NOOP
 #else
+    /* Set to tainted if we are running under tainting mode */
 #   define TAINT               (PL_tainted = PL_tainting)
-#   define TAINT_NOT   (PL_tainted = FALSE)
-#   define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = PL_tainting; }
+
+#   define TAINT_NOT   (PL_tainted = FALSE)        /* Untaint */
+#   define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally taint */
 #   define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); }
-#   define TAINT_PROPER(s)     if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
+                                /* croak or warn if tainting */
+#   define TAINT_PROPER(s)     if (UNLIKELY(PL_tainting)) {                \
+                                    taint_proper(NULL, s);                  \
+                                }
 #   define TAINT_set(s)                (PL_tainted = (s))
 #   define TAINT_get           (PL_tainted)
-#   define TAINTING_get                (PL_tainting)
+#   define TAINTING_get                (PL_tainting)   /* Is taint checking enabled? */
 #   define TAINTING_set(s)     (PL_tainting = (s))
-#   define TAINT_WARN_get       (PL_taint_warn)
+#   define TAINT_WARN_get       (PL_taint_warn) /* FALSE => tainting violations
+                                                            are fatal
+                                                   TRUE =>  they're just
+                                                            warnings */
 #   define TAINT_WARN_set(s)    (PL_taint_warn = (s))
 #endif
 
@@ -6248,7 +6256,7 @@ typedef struct am_table_short AMTS;
             else {                                                          \
                 PL_lc_numeric_mutex_depth++;                                \
                 DEBUG_Lv(PerlIO_printf(Perl_debug_log,                      \
-                        "%s: %d: avoided lc_numeric_lock; depth=%d\n",      \
+                        "%s: %d: avoided lc_numeric_lock; new depth=%d\n",  \
                         __FILE__, __LINE__, PL_lc_numeric_mutex_depth));    \
                 if (cond_to_panic_if_already_locked) {                      \
                     Perl_croak_nocontext("panic: %s: %d: Trying to change"  \
@@ -6270,7 +6278,7 @@ typedef struct am_table_short AMTS;
             else {                                                          \
                 PL_lc_numeric_mutex_depth--;                                \
                 DEBUG_Lv(PerlIO_printf(Perl_debug_log,                      \
-                        "%s: %d: avoided lc_numeric_unlock; depth=%d\n",    \
+                        "%s: %d: avoided lc_numeric_unlock; new depth=%d\n",\
                         __FILE__, __LINE__, PL_lc_numeric_mutex_depth));    \
             }                                                               \
         } STMT_END                                                          \
@@ -6420,8 +6428,8 @@ expression, but with an empty argument list, like this:
 #  define STORE_LC_NUMERIC_SET_TO_NEEDED()                                  \
         STMT_START {                                                        \
             LC_NUMERIC_LOCK(                                                \
-                          (IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \
-                      || _NOT_IN_NUMERIC_STANDARD);                         \
+                    (   (  IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \
+                     || (! IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_STANDARD)));\
             if (IN_LC(LC_NUMERIC)) {                                        \
                 if (_NOT_IN_NUMERIC_UNDERLYING) {                           \
                     Perl_set_numeric_underlying(aTHX);                      \
@@ -6528,27 +6536,13 @@ expression, but with an empty argument list, like this:
 #endif /* !USE_LOCALE_NUMERIC */
 
 #define Atof                           my_atof
+#define Strtod                          my_strtod
 
-#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)
+#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) && \