# define PERL_UNUSED_VAR(x) ((void)x)
#endif
-#ifdef USE_ITHREADS
+#if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT)
# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
#else
# define PERL_UNUSED_CONTEXT
#endif
/* Use PERL_UNUSED_RESULT() to suppress the warnings about unused results
- * of function calls, e.g. PERL_UNUSED_RESULT(foo(a, b)). Use it sparingly,
- * though, since usually the warning is there for a good reason,
- * e.g. for realloc(): the new pointer is not necessarily the old pointer.
+ * of function calls, e.g. PERL_UNUSED_RESULT(foo(a, b)).
+ *
+ * The main reason for this is that the combination of gcc -Wunused-result
+ * (part of -Wall) and the __attribute__((warn_unused_result)) cannot
+ * be silenced with casting to void. This causes trouble when the system
+ * header files use the attribute.
+ *
+ * Use PERL_UNUSED_RESULT sparingly, though, since usually the warning
+ * is there for a good reason: you might lose success/failure information,
+ * or leak resources, or changes in resources.
*
* But sometimes you just want to ignore the return value, e.g. on
- * codepaths soon ending up in abort, or in "best effort" attempts.
- * Sometimes you can capture the return value and use PERL_UNUSED_VAR
- * on that.
+ * codepaths soon ending up in abort, or in "best effort" attempts,
+ * or in situations where there is no good way to handle failures.
*
- * The combination of gcc -Wunused-result (part of -Wall) and the gcc
- * warn_unused_result attribute cannot be silenced with (void).
+ * Sometimes PERL_UNUSED_RESULT might not be the most natural way:
+ * another possibility is that you can capture the return value
+ * and use PERL_UNUSED_VAR on that.
*
- * The __typeof__() is unused instead of typeof() since typeof() is
- * not available under stricter ANSI modes, and because of compilers
- * masquerading as gcc (clang and icc), we want exactly the gcc
- * extension __typeof__ and nothing else.
+ * The __typeof__() is used instead of typeof() since typeof() is not
+ * available under strict C89, and because of compilers masquerading
+ * as gcc (clang and icc), we want exactly the gcc extension
+ * __typeof__ and nothing else.
*/
#ifndef PERL_UNUSED_RESULT
-# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define PERL_UNUSED_RESULT(v) ({ __typeof__(v) z = (v); (void)sizeof(z); })
+# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
# else
# define PERL_UNUSED_RESULT(v) ((void)(v))
# endif
*
* Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011;
* clang only pretends to be GCC 4.2, but still supports push/pop.
+ *
+ * Note on usage: on non-gcc (or lookalike, like clang) compilers
+ * one cannot use these at file (global) level without warnings
+ * since they are defined as empty, which leads into the terminating
+ * semicolon being left alone on a line:
+ * ;
+ * which makes compilers mildly cranky. Therefore at file level one
+ * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE_FILE *without*
+ * the semicolons.
+ *
+ * (A dead-on-arrival solution would be to try to define the macros as
+ * NOOP or dNOOP, those don't work both inside functions and outside.)
*/
-#if defined(__clang) || \
+#if defined(__clang__) || defined(__clang) || \
(defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406)
-# define GCC_DIAG_DO_PRAGMA_(x) _Pragma (#x)
-
+# define GCC_DIAG_PRAGMA(x) _Pragma (#x)
+/* clang has "clang diagnostic" pragmas, but also understands gcc. */
# define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \
- GCC_DIAG_DO_PRAGMA_(GCC diagnostic ignored #x)
+ GCC_DIAG_PRAGMA(GCC diagnostic ignored #x)
# define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop")
#else
# define GCC_DIAG_IGNORE(w)
# define GCC_DIAG_RESTORE
#endif
-
#define NOOP /*EMPTY*/(void)0
/* cea2e8a9dd23747f accidentally lost the comment originally from the first
check in of thread.h, explaining why we need dNOOP at all: */
# endif
#endif
-#ifdef USE_NEXT_CTYPE
-
-#if NX_CURRENT_COMPILER_RELEASE >= 500
-# include <bsd/ctypes.h>
-#else
-# if NX_CURRENT_COMPILER_RELEASE >= 400
-# include <objc/NXCType.h>
-# else /* NX_CURRENT_COMPILER_RELEASE < 400 */
-# include <appkit/NXCType.h>
-# endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */
-#endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */
-
-#else /* !USE_NEXT_CTYPE */
#include <ctype.h>
-#endif /* USE_NEXT_CTYPE */
#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
#undef METHOD
# if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
# define USE_LOCALE_MONETARY
# endif
+# if !defined(NO_LOCALE_TIME) && defined(LC_TIME)
+# define USE_LOCALE_TIME
+# endif
# ifndef WIN32 /* No wrapper except on Windows */
# define my_setlocale(a,b) setlocale(a,b)
# endif
# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
#endif
+/* ptrdiff_t is C11, so undef it under pedantic builds */
+#ifdef PERL_GCC_PEDANTIC
+# undef HAS_PTRDIFF_T
+#endif
+
#ifndef __SYMBIAN32__
# if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
# define CHECK_MALLOC_TAINT(newval) \
CHECK_MALLOC_TOO_LATE_FOR_( \
if (newval) { \
- panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
+ PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\
exit(1); })
# define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \
if (doing_taint(argc,argv,env)) { \
/* Configure already sets Direntry_t */
#if defined(I_DIRENT)
# include <dirent.h>
- /* NeXT needs dirent + sys/dir.h */
-# if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
-# include <sys/dir.h>
-# endif
#else
# ifdef I_SYS_NDIR
# include <sys/ndir.h>
* that should be true only if the snprintf()/vsnprintf() are true
* to the standard. */
+#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
+
#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; })
+# define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
# define PERL_MY_SNPRINTF_GUARDED
# else
-# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__)
+# define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__)
# endif
#else
# define my_snprintf Perl_my_snprintf
#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; })
+# define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
# define PERL_MY_VSNPRINTF_GUARDED
# else
-# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
+# define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__)
# endif
#else
# define my_vsnprintf Perl_my_vsnprintf
# define PERL_MY_VSNPRINTF_GUARDED
#endif
+/* You will definitely need to use the PERL_MY_SNPRINTF_POST_GUARD()
+ * or PERL_MY_VSNPRINTF_POST_GUARD() if you otherwise decide to ignore
+ * the result of my_snprintf() or my_vsnprintf(). (No, you should not
+ * completely ignore it: otherwise you cannot know whether your output
+ * was too long.)
+ *
+ * int len = my_sprintf(buf, max, ...);
+ * PERL_MY_SNPRINTF_POST_GUARD(len, max);
+ *
+ * The trick is that in certain platforms [a] the my_sprintf() already
+ * contains the sanity check, while in certain platforms [b] it needs
+ * to be done as a separate step. The POST_GUARD is that step-- in [a]
+ * platforms the POST_GUARD actually does nothing since the check has
+ * already been done. Watch out for the max being the same in both calls.
+ *
+ * If you actually use the snprintf/vsnprintf return value already,
+ * you assumedly are checking its validity somehow. But you can
+ * insert the POST_GUARD() also in that case. */
+
+#ifndef PERL_MY_SNPRINTF_GUARDED
+# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf)
+#else
+# define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
+#endif
+
+#ifndef PERL_MY_VSNPRINTF_GUARDED
+# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf)
+#else
+# define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
+#endif
+
#ifdef HAS_STRLCAT
# define my_strlcat strlcat
#else
# endif
#endif
-#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1)
+#define Size_t_MAX (~(Size_t)0)
+#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
# ifdef LDBL_MAX
# define NV_MAX LDBL_MAX
# endif
+# ifdef LDBL_MIN_EXP
+# define NV_MIN_EXP LDBL_MIN_EXP
+# endif
+# ifdef LDBL_MAX_EXP
+# define NV_MAX_EXP LDBL_MAX_EXP
+# endif
# ifdef LDBL_MIN_10_EXP
# define NV_MIN_10_EXP LDBL_MIN_10_EXP
# endif
# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
# endif
# endif
+# ifdef HAS_LDEXPL
+# define Perl_ldexp(x, y) ldexpl(x,y)
+# else
+# if defined(HAS_SCALBNL) && FLT_RADIX == 2
+# define Perl_ldexp(x,y) scalbnl(x,y)
+# endif
+# endif
# ifndef Perl_isnan
# ifdef HAS_ISNANL
# define Perl_isnan(x) isnanl(x)
# define Perl_isinf(x) !(finitel(x)||Perl_isnan(x))
# endif
# endif
+# ifndef Perl_isfinite
+# ifdef HAS_ISFINITEL
+# define Perl_isfinite(x) isfinitel(x)
+# elif defined(HAS_FINITEL)
+# define Perl_isfinite(x) finitel(x)
+# endif
+# endif
#else
# define NV_DIG DBL_DIG
# ifdef DBL_MANT_DIG
# ifdef DBL_MAX
# define NV_MAX DBL_MAX
# endif
+# ifdef DBL_MIN_EXP
+# define NV_MIN_EXP DBL_MIN_EXP
+# endif
+# ifdef DBL_MAX_EXP
+# define NV_MAX_EXP DBL_MAX_EXP
+# endif
# ifdef DBL_MIN_10_EXP
# define NV_MIN_10_EXP DBL_MIN_10_EXP
# endif
# define Perl_fmod fmod
# define Perl_modf(x,y) modf(x,y)
# define Perl_frexp(x,y) frexp(x,y)
+# define Perl_ldexp(x,y) ldexp(x,y)
#endif
/* rumor has it that Win32 has _fpclass() */
#endif
#ifndef Perl_isfinite
-# ifdef HAS_FINITE
+# ifdef HAS_ISFINITE
+# define Perl_isfinite(x) isfinite((NV)x)
+# elif defined(HAS_FINITE)
# define Perl_isfinite(x) finite((NV)x)
+# elif defined(Perl_fp_class_finite)
+# define Perl_isfinite(x) Perl_fp_class_finite(x)
+# elif defined(Perl_is_inf) && defined(Perl_is_nan)
+# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
# else
-# ifdef HAS_ISFINITE
-# define Perl_isfinite(x) isfinite(x)
-# else
-# ifdef Perl_fp_class_finite
-# define Perl_isfinite(x) Perl_fp_class_finite(x)
-# else
-# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
-# endif
-# endif
+/* NaN*0 is NaN, [+-]Inf*0 is NaN, zero for anything else. */
+# define Perl_isfinite(x) (((x) * 0) == 0)
# endif
#endif
typedef MEM_SIZE STRLEN;
-#ifdef PERL_MAD
-typedef struct token TOKEN;
-typedef struct madprop MADPROP;
-typedef struct nexttoken NEXTTOKE;
-#endif
typedef struct op OP;
typedef struct cop COP;
typedef struct unop UNOP;
#endif
/*
+=head1 Miscellaneous Functions
+
=for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv
Provides system-specific tune up of the C runtime environment necessary to
run Perl interpreters. This should be called only once, before creating
# else
# ifdef I_MACH_CTHREADS
# include <mach/cthreads.h>
-# if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
-# define MUTEX_INIT_CALLS_MALLOC
-# endif
typedef cthread_t perl_os_thread;
typedef mutex_t perl_mutex;
typedef condition_t perl_cond;
#endif
#include "perly.h"
-#ifdef PERL_MAD
-struct nexttoken {
- YYSTYPE next_val; /* value of next token, if any */
- I32 next_type; /* type of next token */
- MADPROP *next_mad; /* everything else about that token */
-};
-#endif
/* macros to define bit-fields in structs. */
#ifndef PERL_BITFIELD8
"\", line %d", STRINGIFY(what), __LINE__), \
(void) 0)))
+/* assert() gets defined if DEBUGGING (and I_ASSERT).
+ * If no DEBUGGING, the <assert.h> has not been included. */
#ifndef assert
# define assert(what) Perl_assert(what)
#endif
#endif
#ifndef __cplusplus
-# if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
-char *crypt (); /* Maybe more hosts will need the unprototyped version */
-# else
-# if !defined(WIN32) && !defined(VMS)
+# if !defined(WIN32) && !defined(VMS)
#ifndef crypt
char *crypt (const char*, const char*);
#endif
-# endif /* !WIN32 */
-# endif /* !NeXT && !__NeXT__ */
+# endif /* !WIN32 */
# ifndef DONT_DECLARE_STD
# ifndef getenv
char *getenv (const char*);
typedef bool (*destroyable_proc_t) (pTHX_ SV *sv);
typedef void (*despatch_signals_proc_t) (pTHX);
-/* NeXT has problems with crt0.o globals */
-#if defined(__DYNAMIC__) && \
- (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
-# if defined(NeXT) || defined(__NeXT)
-# include <mach-o/dyld.h>
-# define environ (*environ_pointer)
-EXT char *** environ_pointer;
-# else
-# if defined(PERL_DARWIN) && defined(PERL_CORE)
-# include <crt_externs.h> /* for the env array */
-# define environ (*_NSGetEnviron())
-# endif
-# endif
+#if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE)
+# include <crt_externs.h> /* for the env array */
+# define environ (*_NSGetEnviron())
#else
/* VMS and some other platforms don't use the environ array */
# ifdef USE_ENVIRON_ARRAY
# ifdef PERL_GLOBAL_STRUCT
" PERL_GLOBAL_STRUCT"
# endif
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ " PERL_GLOBAL_STRUCT_PRIVATE"
+# endif
# ifdef PERL_IMPLICIT_CONTEXT
" PERL_IMPLICIT_CONTEXT"
# endif
# ifdef PERL_IMPLICIT_SYS
" PERL_IMPLICIT_SYS"
# endif
-# ifdef PERL_MAD
- " PERL_MAD"
-# endif
# ifdef PERL_MICRO
" PERL_MICRO"
# endif
# ifdef USE_LOCALE_NUMERIC
" USE_LOCALE_NUMERIC"
# endif
+# ifdef USE_LOCALE_TIME
+ " USE_LOCALE_TIME"
+# endif
# ifdef USE_LONG_DOUBLE
" USE_LONG_DOUBLE"
# endif
XATTRBLOCK,
XATTRTERM,
XTERMBLOCK,
+ XBLOCKTERM,
XPOSTDEREF,
XTERMORDORDOR /* evil hack */
/* update exp_name[] in toke.c if adding to this enum */
However, bitops store HINT_INTEGER in their op_private.
NOTE: The typical module using these has the bit value hard-coded, so don't
- blindly change the values of these */
+ blindly change the values of these.
+
+ If we run out of bits, the 2 locale ones could be combined. The PARTIAL one
+ is for "use locale 'FOO'" which excludes some categories. It requires going
+ to %^H to find out which are in and which are out. This could be extended
+ for the normal case of a plain HINT_LOCALE, so that %^H would be used for
+ any locale form. */
#define HINT_INTEGER 0x00000001 /* integer pragma */
#define HINT_STRICT_REFS 0x00000002 /* strict pragma */
#define HINT_LOCALE 0x00000004 /* locale pragma */
#define HINT_BYTES 0x00000008 /* bytes pragma */
-#define HINT_LOCALE_NOT_CHARS 0x00000010 /* locale ':not_characters' pragma */
+#define HINT_LOCALE_PARTIAL 0x00000010 /* locale, but a subset of categories */
#define HINT_EXPLICIT_STRICT_REFS 0x00000020 /* strict.pm */
#define HINT_EXPLICIT_STRICT_SUBS 0x00000040 /* strict.pm */
#if !defined(PERL_FOR_X2P)
# include "embedvar.h"
#endif
-#ifndef PERL_MAD
-# undef PL_madskills
-# undef PL_xmlfp
-# define PL_madskills 0
-# define PL_xmlfp 0
-#endif
/* Now include all the 'global' variables
* If we don't have threads or multiple interpreters
In particular, need the relevant *ish file included already, as it may
define HAVE_INTERP_INTERN */
#include "embed.h"
-#ifndef PERL_MAD
-# undef op_getmad
-# define op_getmad(arg,pegop,slot) NOOP
-#endif
#ifndef PERL_GLOBAL_STRUCT
START_EXTERN_C
#endif
+
+/* if these never got defined, they need defaults */
+#ifndef PERL_SET_CONTEXT
+# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i)
+#endif
+
+#ifndef PERL_GET_CONTEXT
+# define PERL_GET_CONTEXT PERL_GET_INTERP
+#endif
+
+#ifndef PERL_GET_THX
+# define PERL_GET_THX ((void*)NULL)
+#endif
+
+#ifndef PERL_SET_THX
+# define PERL_SET_THX(t) NOOP
+#endif
+
+
#ifndef PERL_NO_INLINE_FUNCTIONS
/* Static inline funcs that depend on includes and declarations above.
Some of these reference functions in the perl object files, and some
#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
-#ifdef USE_LOCALE_NUMERIC
-
+#ifdef USE_LOCALE
+/* These locale things are all subject to change */
/* Returns TRUE if the plain locale pragma without a parameter is in effect
*/
-#define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
+# define IN_LOCALE_RUNTIME cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE)
/* Returns TRUE if either form of the locale pragma is in effect */
-#define IN_SOME_LOCALE_FORM_RUNTIME \
- cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+# define IN_SOME_LOCALE_FORM_RUNTIME \
+ cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-#define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
-#define IN_SOME_LOCALE_FORM_COMPILETIME \
- cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_NOT_CHARS))
+# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
+# define IN_SOME_LOCALE_FORM_COMPILETIME \
+ cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-#define IN_LOCALE \
+# define IN_LOCALE \
(IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-#define IN_SOME_LOCALE_FORM \
+# define IN_SOME_LOCALE_FORM \
(IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
: IN_SOME_LOCALE_FORM_RUNTIME)
+# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
+# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
+
+# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
+# define IN_LC_PARTIAL_RUNTIME \
+ cBOOL(CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
+
+# define IN_LC_COMPILETIME(category) \
+ (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
+ && _is_in_locale_category(TRUE, (category))))
+# define IN_LC_RUNTIME(category) \
+ (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
+ && _is_in_locale_category(FALSE, (category))))
+# define IN_LC(category) \
+ (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
+
+#else /* No locale usage */
+# define IN_LOCALE_RUNTIME 0
+# define IN_SOME_LOCALE_FORM_RUNTIME 0
+# define IN_LOCALE_COMPILETIME 0
+# define IN_SOME_LOCALE_FORM_COMPILETIME 0
+# define IN_LOCALE 0
+# define IN_SOME_LOCALE_FORM 0
+# define IN_LC_ALL_COMPILETIME 0
+# define IN_LC_ALL_RUNTIME 0
+# define IN_LC_PARTIAL_COMPILETIME 0
+# define IN_LC_PARTIAL_RUNTIME 0
+# define IN_LC_COMPILETIME(category) 0
+# define IN_LC_RUNTIME(category) 0
+# define IN_LC(category) 0
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
+
/* These macros are for toggling between the underlying locale (LOCAL) and the
* C locale. */
* RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before
* these were called */
+#define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard)
+
+/* We can lock the category to stay in the C locale, making requests to the
+ * contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */
+#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2)
+
#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \
void (*_restore_LC_NUMERIC_function)(pTHX) = NULL;
#define STORE_LC_NUMERIC_SET_TO_NEEDED() \
- if (IN_SOME_LOCALE_FORM) { \
- if (! PL_numeric_local) { \
- SET_NUMERIC_LOCAL(); \
+ if (IN_LC(LC_NUMERIC)) { \
+ if (_NOT_IN_NUMERIC_LOCAL) { \
+ set_numeric_local(); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
} \
} \
else { \
- if (! PL_numeric_standard) { \
+ if (_NOT_IN_NUMERIC_STANDARD) { \
SET_NUMERIC_STANDARD(); \
_restore_LC_NUMERIC_function = &Perl_set_numeric_local; \
} \
/* The next two macros set unconditionally. These should be rarely used, and
* only after being sure that this is what is needed */
-#define SET_NUMERIC_STANDARD() \
- set_numeric_standard();
+#define SET_NUMERIC_STANDARD() \
+ STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \
+ } STMT_END
-#define SET_NUMERIC_LOCAL() \
- set_numeric_local();
+#define SET_NUMERIC_LOCAL() \
+ STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \
+ set_numeric_local(); } STMT_END
/* The rest of these LC_NUMERIC macros toggle to one or the other state, with
* the RESTORE_foo ones called to switch back, but only if need be */
-#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
- bool was_local = PL_numeric_local; \
- if (was_local) SET_NUMERIC_STANDARD();
+#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
+ bool _was_local = _NOT_IN_NUMERIC_STANDARD; \
+ if (_was_local) set_numeric_standard();
/* Doesn't change to underlying locale unless within the scope of some form of
* 'use locale'. This is the usual desired behavior. */
-#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
- bool was_standard = PL_numeric_standard && IN_SOME_LOCALE_FORM; \
- if (was_standard) SET_NUMERIC_LOCAL();
+#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
+ bool _was_standard = _NOT_IN_NUMERIC_LOCAL \
+ && IN_LC(LC_NUMERIC); \
+ if (_was_standard) set_numeric_local();
/* Rarely, we want to change to the underlying locale even outside of 'use
* locale'. This is principally in the POSIX:: functions */
-#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
- bool was_standard = PL_numeric_standard; \
- if (was_standard) SET_NUMERIC_LOCAL();
+#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \
+ bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \
+ if (_was_standard) set_numeric_local();
+
+/* Lock to the C locale until unlock is called */
+#define LOCK_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard) \
+ PL_numeric_standard = 2)
+
+#define UNLOCK_NUMERIC_STANDARD() \
+ (__ASSERT_(PL_numeric_standard == 2) \
+ PL_numeric_standard = 1)
#define RESTORE_NUMERIC_LOCAL() \
- if (was_local) SET_NUMERIC_LOCAL();
+ if (_was_local) set_numeric_local();
#define RESTORE_NUMERIC_STANDARD() \
- if (was_standard) SET_NUMERIC_STANDARD();
+ if (_was_standard) SET_NUMERIC_STANDARD();
#define Atof my_atof
#define STORE_LC_NUMERIC_SET_TO_NEEDED()
#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED()
#define RESTORE_LC_NUMERIC()
+#define LOCK_NUMERIC_STANDARD()
+#define UNLOCK_NUMERIC_STANDARD()
#define Atof my_atof
-#define IN_LOCALE_RUNTIME 0
-#define IN_LOCALE_COMPILETIME 0
#endif /* !USE_LOCALE_NUMERIC */
# define Atoul(s) Strtoul(s, NULL, 10)
#endif
-
-/* if these never got defined, they need defaults */
-#ifndef PERL_SET_CONTEXT
-# define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i)
-#endif
-
-#ifndef PERL_GET_CONTEXT
-# define PERL_GET_CONTEXT PERL_GET_INTERP
-#endif
-
-#ifndef PERL_GET_THX
-# define PERL_GET_THX ((void*)NULL)
-#endif
-
-#ifndef PERL_SET_THX
-# define PERL_SET_THX(t) NOOP
-#endif
-
#ifndef PERL_SCRIPT_MODE
#define PERL_SCRIPT_MODE "r"
#endif
/* If you really are DOSish. */
# define PERLIO_USING_CRLF 1
# endif
-# if O_TEXT != 0 && O_BINARY != 0
-# if !defined(__HAIKU__)
- /* If you have O_TEXT different from your O_BINARY and
- * they are both not zero (being zero would make testing
- * with bit-and interesting) and they have an effect. */
-# define PERLIO_BINARY_AND_TEXT_DIFFERENT_AND_EFFECTIVE
-# endif
-# endif
#endif
#ifdef I_LIBUTIL
#define IS_NUMBER_NEG 0x08 /* leading minus sign */
#define IS_NUMBER_INFINITY 0x10 /* this is big */
#define IS_NUMBER_NAN 0x20 /* this is not */
+#define IS_NUMBER_TRAILING 0x40 /* number has trailing trash */
#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
#define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */
#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large
numbers which are <= UV_MAX */
+#define PERL_SCAN_TRAILING 0x10 /* grok_number_flags() allow trailing
+ and set IS_NUMBER_TRAILING */
+
/* Output flags: */
#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */