Re: [PATCH] Typemap testing
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 7441ea5..d1cb711 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1692,6 +1692,13 @@ typedef struct ptr_tbl PTR_TBL_t;
 #  define USE_ENVIRON_ARRAY
 #endif
 
+#ifdef JPL
+    /* E.g. JPL needs to operate on a copy of the real environment.
+     * JDK 1.2 and 1.3 seem to get upset if the original environment
+     * is diddled with. */
+#   define NEED_ENVIRON_DUP_FOR_MODIFY
+#endif
+
 #ifndef PERL_SYS_INIT3
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
 #endif
@@ -2124,62 +2131,142 @@ Gid_t getegid (void);
                                 : PerlIO_stderr())
 #endif
 
+
+#define DEBUG_p_FLAG           0x00000001 /*      1 */
+#define DEBUG_s_FLAG           0x00000002 /*      2 */
+#define DEBUG_l_FLAG           0x00000004 /*      4 */
+#define DEBUG_t_FLAG           0x00000008 /*      8 */
+#define DEBUG_o_FLAG           0x00000010 /*     16 */
+#define DEBUG_c_FLAG           0x00000020 /*     32 */
+#define DEBUG_P_FLAG           0x00000040 /*     64 */
+#define DEBUG_m_FLAG           0x00000080 /*    128 */
+#define DEBUG_f_FLAG           0x00000100 /*    256 */
+#define DEBUG_r_FLAG           0x00000200 /*    512 */
+#define DEBUG_x_FLAG           0x00000400 /*   1024 */
+#define DEBUG_u_FLAG           0x00000800 /*   2048 */
+#define DEBUG_L_FLAG           0x00001000 /*   4096 */
+#define DEBUG_H_FLAG           0x00002000 /*   8192 */
+#define DEBUG_X_FLAG           0x00004000 /*  16384 */
+#define DEBUG_D_FLAG           0x00008000 /*  32768 */
+#define DEBUG_S_FLAG           0x00010000 /*  65536 */
+#define DEBUG_T_FLAG           0x00020000 /* 131072 */
+#define DEBUG_R_FLAG           0x00040000 /* 262144 */
+#define DEBUG_MASK             0x0007FFFF /* mask of all the standard flags */
+
+#define DEBUG_DB_RECURSE_FLAG  0x40000000
+#define DEBUG_TOP_FLAG         0x80000000 /* XXX what's this for ??? */
+
+
 #ifdef DEBUGGING
-#undef  YYDEBUG
-#define YYDEBUG 1
-#define DEB(a)                         a
-#define DEBUG(a)   if (PL_debug)               a
-#define DEBUG_p(a) if (PL_debug & 1)   a
-#define DEBUG_s(a) if (PL_debug & 2)   a
-#define DEBUG_l(a) if (PL_debug & 4)   a
-#define DEBUG_t(a) if (PL_debug & 8)   a
-#define DEBUG_o(a) if (PL_debug & 16)  a
-#define DEBUG_c(a) if (PL_debug & 32)  a
-#define DEBUG_P(a) if (PL_debug & 64)  a
+
+#  undef  YYDEBUG
+#  define YYDEBUG 1
+
+#  define DEBUG_p_TEST (PL_debug & DEBUG_p_FLAG)
+#  define DEBUG_s_TEST (PL_debug & DEBUG_s_FLAG)
+#  define DEBUG_l_TEST (PL_debug & DEBUG_l_FLAG)
+#  define DEBUG_t_TEST (PL_debug & DEBUG_t_FLAG)
+#  define DEBUG_o_TEST (PL_debug & DEBUG_o_FLAG)
+#  define DEBUG_c_TEST (PL_debug & DEBUG_c_FLAG)
+#  define DEBUG_P_TEST (PL_debug & DEBUG_P_FLAG)
+#  define DEBUG_m_TEST (PL_debug & DEBUG_m_FLAG)
+#  define DEBUG_f_TEST (PL_debug & DEBUG_f_FLAG)
+#  define DEBUG_r_TEST (PL_debug & DEBUG_r_FLAG)
+#  define DEBUG_x_TEST (PL_debug & DEBUG_x_FLAG)
+#  define DEBUG_u_TEST (PL_debug & DEBUG_u_FLAG)
+#  define DEBUG_L_TEST (PL_debug & DEBUG_L_FLAG)
+#  define DEBUG_H_TEST (PL_debug & DEBUG_H_FLAG)
+#  define DEBUG_X_TEST (PL_debug & DEBUG_X_FLAG)
+#  define DEBUG_D_TEST (PL_debug & DEBUG_D_FLAG)
+#  define DEBUG_S_TEST (PL_debug & DEBUG_S_FLAG)
+#  define DEBUG_T_TEST (PL_debug & DEBUG_T_FLAG)
+#  define DEBUG_R_TEST (PL_debug & DEBUG_R_FLAG)
+
+#  define DEB(a)     a
+#  define DEBUG(a)   if (PL_debug)   a
+#  define DEBUG_p(a) if (DEBUG_p_TEST) a
+#  define DEBUG_s(a) if (DEBUG_s_TEST) a
+#  define DEBUG_l(a) if (DEBUG_l_TEST) a
+#  define DEBUG_t(a) if (DEBUG_t_TEST) a
+#  define DEBUG_o(a) if (DEBUG_o_TEST) a
+#  define DEBUG_c(a) if (DEBUG_c_TEST) a
+#  define DEBUG_P(a) if (DEBUG_P_TEST) a
+
 #  if defined(PERL_OBJECT)
-#    define DEBUG_m(a) if (PL_debug & 128)     a
+#    define DEBUG_m(a) if (DEBUG_m_TEST) a
 #  else
+     /* Temporarily turn off memory debugging in case the a
+      * does memory allocation, either directly or indirectly. */
 #    define DEBUG_m(a)  \
     STMT_START {                                                       \
-       if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } }       \
+        if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
     } STMT_END
 #  endif
-#define DEBUG_f(a) if (PL_debug & 256) a
-#define DEBUG_r(a) if (PL_debug & 512) a
-#define DEBUG_x(a) if (PL_debug & 1024)        a
-#define DEBUG_u(a) if (PL_debug & 2048)        a
-#define DEBUG_L(a) if (PL_debug & 4096)        a
-#define DEBUG_H(a) if (PL_debug & 8192)        a
-#define DEBUG_X(a) if (PL_debug & 16384)       a
-#define DEBUG_D(a) if (PL_debug & 32768)       a
+
+#  define DEBUG_f(a) if (DEBUG_f_TEST) a
+#  define DEBUG_r(a) if (DEBUG_r_TEST) a
+#  define DEBUG_x(a) if (DEBUG_x_TEST) a
+#  define DEBUG_u(a) if (DEBUG_u_TEST) a
+#  define DEBUG_L(a) if (DEBUG_L_TEST) a
+#  define DEBUG_H(a) if (DEBUG_H_TEST) a
+#  define DEBUG_X(a) if (DEBUG_X_TEST) a
+#  define DEBUG_D(a) if (DEBUG_D_TEST) a
+
 #  ifdef USE_THREADS
-#    define DEBUG_S(a) if (PL_debug & (1<<16)) a
+#    define DEBUG_S(a) if (DEBUG_S_TEST) a
 #  else
 #    define DEBUG_S(a)
 #  endif
-#define DEBUG_T(a) if (PL_debug & (1<<17))     a
-#else
-#define DEB(a)
-#define DEBUG(a)
-#define DEBUG_p(a)
-#define DEBUG_s(a)
-#define DEBUG_l(a)
-#define DEBUG_t(a)
-#define DEBUG_o(a)
-#define DEBUG_c(a)
-#define DEBUG_P(a)
-#define DEBUG_m(a)
-#define DEBUG_f(a)
-#define DEBUG_r(a)
-#define DEBUG_x(a)
-#define DEBUG_u(a)
-#define DEBUG_S(a)
-#define DEBUG_H(a)
-#define DEBUG_X(a)
-#define DEBUG_D(a)
-#define DEBUG_S(a)
-#define DEBUG_T(a)
-#endif
+
+#  define DEBUG_T(a) if (DEBUG_T_TEST) a
+#  define DEBUG_R(a) if (DEBUG_R_TEST) a
+
+#else /* DEBUGGING */
+
+#  define DEBUG_p_TEST (0)
+#  define DEBUG_s_TEST (0)
+#  define DEBUG_l_TEST (0)
+#  define DEBUG_t_TEST (0)
+#  define DEBUG_o_TEST (0)
+#  define DEBUG_c_TEST (0)
+#  define DEBUG_P_TEST (0)
+#  define DEBUG_m_TEST (0)
+#  define DEBUG_f_TEST (0)
+#  define DEBUG_r_TEST (0)
+#  define DEBUG_x_TEST (0)
+#  define DEBUG_u_TEST (0)
+#  define DEBUG_L_TEST (0)
+#  define DEBUG_H_TEST (0)
+#  define DEBUG_X_TEST (0)
+#  define DEBUG_D_TEST (0)
+#  define DEBUG_S_TEST (0)
+#  define DEBUG_T_TEST (0)
+#  define DEBUG_R_TEST (0)
+
+#  define DEB(a)
+#  define DEBUG(a)
+#  define DEBUG_p(a)
+#  define DEBUG_s(a)
+#  define DEBUG_l(a)
+#  define DEBUG_t(a)
+#  define DEBUG_o(a)
+#  define DEBUG_c(a)
+#  define DEBUG_P(a)
+#  define DEBUG_m(a)
+#  define DEBUG_f(a)
+#  define DEBUG_r(a)
+#  define DEBUG_x(a)
+#  define DEBUG_u(a)
+#  define DEBUG_L(a)
+#  define DEBUG_H(a)
+#  define DEBUG_X(a)
+#  define DEBUG_D(a)
+#  define DEBUG_S(a)
+#  define DEBUG_T(a)
+#  define DEBUG_R(a)
+#endif /* DEBUGGING */
+
+
 #define YYMAXDEPTH 300
 
 #ifndef assert  /* <assert.h> might have been included somehow */
@@ -2192,11 +2279,33 @@ Gid_t getegid (void);
 #endif
 
 struct ufuncs {
-    I32 (*uf_val)(IV, SV*);
-    I32 (*uf_set)(IV, SV*);
+    I32 (*uf_val)(pTHX_ IV, SV*);
+    I32 (*uf_set)(pTHX_ IV, SV*);
     IV uf_index;
 };
 
+/* In pre-5.7-Perls the 'U' magic didn't get the thread context.
+ * XS code wanting to be backward compatible can do something
+ * like the following:
+
+#ifndef PERL_MG_UFUNC
+#define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv)
+#endif
+
+static PERL_MG_UFUNC(foo_get, index, val)
+{
+    sv_setsv(val, ...);
+    return TRUE;
+}
+
+-- Doug MacEachern
+
+*/
+
+#ifndef PERL_MG_UFUNC
+#define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv)
+#endif
+
 /* Fix these up for __STDC__ */
 #ifndef DONT_DECLARE_STD
 char *mktemp (char*);
@@ -2405,7 +2514,7 @@ EXT char *PL_sig_name[];
 EXT int   PL_sig_num[];
 #endif
 
-/* fast case folding tables */
+/* fast conversion and case folding tables */
 
 #ifdef DOINIT
 #ifdef EBCDIC
@@ -3217,9 +3326,9 @@ typedef struct am_table_short AMTS;
 #define SET_NUMERIC_LOCAL() \
        set_numeric_local();
 
-#define IS_NUMERIC_RADIX(c)    \
+#define IS_NUMERIC_RADIX(s)    \
        ((PL_hints & HINT_LOCALE) && \
-         PL_numeric_radix && (c) == PL_numeric_radix)
+         PL_numeric_radix && memEQ(s, SvPVX(PL_numeric_radix), SvCUR(PL_numeric_radix)))
 
 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
        bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \
@@ -3301,8 +3410,12 @@ typedef struct am_table_short AMTS;
  * Remap printf
  */
 #undef printf
+#ifdef __GNUC__
+#define printf(fmt,args...) PerlIO_stdoutf(fmt,##args)
+#else
 #define printf PerlIO_stdoutf
 #endif
+#endif
 
 /* if these never got defined, they need defaults */
 #ifndef PERL_SET_CONTEXT