This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #120841) document ERRSV and CLEAR_ERRSV()
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 098e1d7..ff42636 100644 (file)
--- a/perl.h
+++ b/perl.h
 #define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP
 #define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP
 
+#if defined(_MSC_VER) && (_MSC_VER >= 1300)
+#  define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \
+                              __pragma(warning(disable : x))
+#  define MSVC_DIAG_RESTORE   __pragma(warning(pop))
+#else
+#  define MSVC_DIAG_IGNORE(x)
+#  define MSVC_DIAG_RESTORE
+#endif
+#define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP
+#define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP
+#define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP
+#define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP
+
 #define NOOP /*EMPTY*/(void)0
 #define dNOOP struct Perl___notused_struct
 
 #   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 TAINT_get           (PL_tainted)    /* Is something tainted? */
+#   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
 
 
 #include <sys/types.h>
 
-/* EVC 4 SDK headers includes a bad definition of MB_CUR_MAX in stdlib.h
-  which is included from stdarg.h. Bad definition not present in SD 2008
-  SDK headers. wince.h is not yet included, so we cant fix this from there
-  since by then MB_CUR_MAX will be defined from stdlib.h.
-  cewchar.h includes a correct definition of MB_CUR_MAX and it is copied here
-  since cewchar.h can't be included this early */
-#if defined(UNDER_CE) && (_MSC_VER < 1300)
-#  define MB_CUR_MAX 1uL
-#endif
-
 # include <stdarg.h>
 
 #ifdef I_STDINT
 #   include <xlocale.h>
 #endif
 
-#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
-#   define USE_LOCALE
+/* If not forbidden, we enable locale handling if either 1) the POSIX 2008
+ * functions are available, or 2) just the setlocale() function.  This logic is
+ * repeated in t/loc_tools.pl and makedef.pl;  The three should be kept in
+ * sync. */
+#if   ! defined(NO_LOCALE)
+
+#  if ! defined(NO_POSIX_2008_LOCALE)           \
+   &&   defined(HAS_NEWLOCALE)                  \
+   &&   defined(HAS_USELOCALE)                  \
+   &&   defined(HAS_DUPLOCALE)                  \
+   &&   defined(HAS_FREELOCALE)                 \
+   &&   defined(LC_ALL_MASK)
+
+    /* For simplicity, the code is written to assume that any platform advanced
+     * enough to have the Posix 2008 locale functions has LC_ALL.  The final
+     * test above makes sure that assumption is valid */
+
+#    define HAS_POSIX_2008_LOCALE
+#    define USE_LOCALE
+#  elif defined(HAS_SETLOCALE)
+#    define USE_LOCALE
+#  endif
+#endif
+
+#ifdef USE_LOCALE
 #   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
                                    #define */
 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
 #   if !defined(NO_LOCALE_TELEPHONE) && defined(LC_TELEPHONE)
 #      define USE_LOCALE_TELEPHONE
 #   endif
-#endif /* !NO_LOCALE && HAS_SETLOCALE */
 
 /* XXX The next few defines are unfortunately duplicated in makedef.pl, and
  * changes here MUST also be made there */
 
-#ifdef USE_LOCALE /* These locale things are all subject to change */
-#  if      defined(HAS_NEWLOCALE)               \
-      &&   defined(LC_ALL_MASK)                 \
-      &&   defined(HAS_FREELOCALE)              \
-      &&   defined(HAS_USELOCALE)               \
-      && ! defined(NO_POSIX_2008_LOCALE)
-
-    /* For simplicity, the code is written to assume that any platform advanced
-     * enough to have the Posix 2008 locale functions has LC_ALL.  The test
-     * above makes sure that assumption is valid */
-
-#    define HAS_POSIX_2008_LOCALE
-#  endif
+#  if ! defined(HAS_SETLOCALE) && defined(HAS_POSIX_2008_LOCALE)
+#      define USE_POSIX_2008_LOCALE
+#      ifndef USE_THREAD_SAFE_LOCALE
+#        define USE_THREAD_SAFE_LOCALE
+#      endif
                                    /* If compiled with
                                     * -DUSE_THREAD_SAFE_LOCALE, will do so even
                                     * on unthreaded builds */
-#  if    (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE))         \
-      && (    defined(HAS_POSIX_2008_LOCALE)                                \
-          || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400))     \
-      && ! defined(NO_THREAD_SAFE_LOCALE)
+#  elif   (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE))         \
+       && (    defined(HAS_POSIX_2008_LOCALE)                                \
+           || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400))     \
+       && ! defined(NO_THREAD_SAFE_LOCALE)
 #    ifndef USE_THREAD_SAFE_LOCALE
 #      define USE_THREAD_SAFE_LOCALE
 #    endif
@@ -1310,6 +1335,22 @@ EXTERN_C char *crypt(const char *, const char *);
 #   define RESTORE_ERRNO  (errno = saved_errno)
 #endif
 
+/*
+=head1 Warning and Dieing
+
+=for apidoc Amn|SV *|ERRSV
+
+Returns the SV for C<$@>, creating it if needed.
+
+=for apidoc Am|void|CLEAR_ERRSV
+
+Clear the contents of C<$@>, setting it to the empty string.
+
+This replaces any read-only SV with a fresh SV and removes any magic.
+
+=cut
+*/
+
 #define ERRSV GvSVn(PL_errgv)
 
 /* contains inlined gv_add_by_type */
@@ -1640,8 +1681,6 @@ EXTERN_C char *crypt(const char *, const char *);
 
 #ifdef HAS_STRLCAT
 #  define my_strlcat    strlcat
-#else
-#  define my_strlcat    Perl_my_strlcat
 #endif
 
 #if defined(PERL_CORE) || defined(PERL_EXT)
@@ -1654,14 +1693,10 @@ EXTERN_C char *crypt(const char *, const char *);
 
 #ifdef HAS_STRLCPY
 #  define my_strlcpy   strlcpy
-#else
-#  define my_strlcpy   Perl_my_strlcpy
 #endif
 
 #ifdef HAS_STRNLEN
 #  define my_strnlen   strnlen
-#else
-#  define my_strnlen   Perl_my_strnlen
 #endif
 
 /*
@@ -2263,10 +2298,6 @@ extern long double Perl_my_frexpl(long double x, int *e);
     (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x))
 #endif
 
-#ifdef UNDER_CE
-int isnan(double d);
-#endif
-
 #ifndef Perl_isnan
 #   ifdef Perl_fp_class_nan
 #       define Perl_isnan(x) Perl_fp_class_nan(x)
@@ -3494,9 +3525,9 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex)
 #  define NOT_REACHED
 #elif defined(DEBUGGING) && (__has_builtin(__builtin_unreachable) \
      || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 4)) /* 4.5 -> */
-#  define NOT_REACHED STMT_START { ASSUME(0); __builtin_unreachable(); } STMT_END
+#  define NOT_REACHED STMT_START { ASSUME(!"UNREACHABLE"); __builtin_unreachable(); } STMT_END
 #else
-#  define NOT_REACHED ASSUME(0)
+#  define NOT_REACHED ASSUME(!"UNREACHABLE")
 #endif
 
 /* Some unistd.h's give a prototype for pause() even though
@@ -3871,7 +3902,7 @@ my_swap16(const U16 x) {
 #endif
 
 #ifndef __cplusplus
-#if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN))
+#if !(defined(WIN32) || defined(SYMBIAN))
 Uid_t getuid (void);
 Uid_t geteuid (void);
 Gid_t getgid (void);
@@ -6221,7 +6252,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"  \
@@ -6243,7 +6274,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                                                          \
@@ -6393,8 +6424,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);                      \
@@ -6501,27 +6532,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) && \
@@ -6838,10 +6855,6 @@ extern void moncontrol(int);
 #define PERL_GPROF_MONCONTROL(x)
 #endif
 
-#ifdef UNDER_CE
-#include "wince.h"
-#endif
-
 /* ISO 6429 NEL - C1 control NExt Line */
 /* See http://www.unicode.org/unicode/reports/tr13/ */
 #define NEXT_LINE_CHAR NEXT_LINE_NATIVE