Adding the new test would be swell.
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 83daa4d..9283e8e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -226,7 +226,7 @@ struct perl_thread;
 #endif
 
 #define NOOP (void)0
-#define dNOOP extern int Perl___notused
+#define dNOOP extern int Perl___notused __attribute__ ((unused))
 
 #ifndef pTHX
 #  define pTHX         void
@@ -1028,6 +1028,13 @@ typedef struct perl_mstats perl_mstats_t;
 #undef UV
 #endif
 
+/* Configure gets this right but the UTS compiler gets it wrong.
+   -- Hal Morris <hom00@utsglobal.com> */
+#ifdef UTS
+#  undef  UVTYPE
+#  define UVTYPE unsigned
+#endif
+
 /*
     The IV type is supposed to be long enough to hold any integral
     value or a pointer.
@@ -2105,25 +2112,52 @@ struct ptr_tbl {
        /* otherwise default to functions in util.c */
 #endif
 
-#ifdef CASTNEGFLOAT
-#define U_S(what) ((U16)(what))
-#define U_I(what) ((unsigned int)(what))
-#define U_L(what) ((U32)(what))
-#else
-#define U_S(what) ((U16)cast_ulong((NV)(what)))
-#define U_I(what) ((unsigned int)cast_ulong((NV)(what)))
-#define U_L(what) (cast_ulong((NV)(what)))
-#endif
+/* *MAX Plus 1. A floating point value.
+   Hopefully expressed in a way that dodgy floating point can't mess up.
+   >> 2 rather than 1, so that value is safely less than I32_MAX after 1
+   is added to it
+   May find that some broken compiler will want the value cast to I32.
+   [after the shift, as signed >> may not be as secure as unsigned >>]
+*/
+#define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1)))
+#define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2)))
+/* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or
+   0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV)
+   may be greater than sizeof(IV), so don't assume that half max UV is max IV.
+*/
+#define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2)))
 
-#ifdef CASTI32
-#define I_32(what) ((I32)(what))
-#define I_V(what) ((IV)(what))
-#define U_V(what) ((UV)(what))
-#else
+#define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2)))
+#define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1)))
+#define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2)))
+
+/* This may look like unnecessary jumping through hoops, but converting
+   out of range floating point values to integers *is* undefined behaviour,
+   and it is starting to bite.
+*/
+#ifndef CAST_INLINE
 #define I_32(what) (cast_i32((NV)(what)))
+#define U_32(what) (cast_ulong((NV)(what)))
 #define I_V(what) (cast_iv((NV)(what)))
 #define U_V(what) (cast_uv((NV)(what)))
-#endif
+#else
+#define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \
+                  : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \
+                     : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */)))
+#define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
+                  : ((n) < U32_MAX_P1 ? (U32) (n) \
+                     : ((n) > 0 ? U32_MAX : 0 /* NaN */)))
+#define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \
+                  : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \
+                     : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
+#define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \
+                  : ((n) < UV_MAX_P1 ? (UV) (n) \
+                     : ((n) > 0 ? UV_MAX : 0 /* NaN */)))
+#endif
+
+#define U_S(what) ((U16)U_32(what))
+#define U_I(what) ((unsigned int)U_32(what))
+#define U_L(what) U_32(what)
 
 /* These do not care about the fractional part, only about the range. */
 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
@@ -2293,6 +2327,52 @@ Gid_t getegid (void);
 #endif /* DEBUGGING */
 
 
+/* These constants should be used in preference to to raw characters
+ * when using magic. Note that some perl guts still assume
+ * certain character properties of these constants, namely that
+ * isUPPER() and toLOWER() may do useful mappings.
+ *
+ * Update the magic_names table in dump.c when adding/amending these
+ */
+
+#define PERL_MAGIC_sv            '\0' /* Special scalar variable */
+#define PERL_MAGIC_overload      'A' /* %OVERLOAD hash */
+#define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
+#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
+#define PERL_MAGIC_bm            'B' /* Boyer-Moore (fast string search) */
+#define PERL_MAGIC_regdata       'D' /* Regex match position data
+                                       (@+ and @- vars) */
+#define PERL_MAGIC_regdatum      'd' /* Regex match position data element */
+#define PERL_MAGIC_env           'E' /* %ENV hash */
+#define PERL_MAGIC_envelem       'e' /* %ENV hash element */
+#define PERL_MAGIC_fm            'f' /* Formline ('compiled' format) */
+#define PERL_MAGIC_regex_global          'g' /* m//g target / study()ed string */
+#define PERL_MAGIC_isa           'I' /* @ISA array */
+#define PERL_MAGIC_isaelem       'i' /* @ISA array element */
+#define PERL_MAGIC_nkeys         'k' /* scalar(keys()) lvalue */
+#define PERL_MAGIC_dbfile        'L' /* Debugger %_<filename */
+#define PERL_MAGIC_dbline        'l' /* Debugger %_<filename element */
+#define PERL_MAGIC_mutex         'm' /* ??? */
+#define PERL_MAGIC_collxfrm      'o' /* Locale transformation */
+#define PERL_MAGIC_tied                  'P' /* Tied array or hash */
+#define PERL_MAGIC_tiedelem      'p' /* Tied array or hash element */
+#define PERL_MAGIC_tiedscalar    'q' /* Tied scalar or handle */
+#define PERL_MAGIC_qr            'r' /* precompiled qr// regex */
+#define PERL_MAGIC_sig           'S' /* %SIG hash */
+#define PERL_MAGIC_sigelem       's' /* %SIG hash element */
+#define PERL_MAGIC_taint         't' /* Taintedness */
+#define PERL_MAGIC_uvar                  'U' /* Available for use by extensions */
+#define PERL_MAGIC_vec           'v' /* vec() lvalue */
+#define PERL_MAGIC_substr        'x' /* substr() lvalue */
+#define PERL_MAGIC_defelem       'y' /* Shadow "foreach" iterator variable /
+                                       smart parameter vivification */
+#define PERL_MAGIC_glob                  '*' /* GV (typeglob) */
+#define PERL_MAGIC_arylen        '#' /* Array length ($#ary) */
+#define PERL_MAGIC_pos           '.' /* pos() lvalue */
+#define PERL_MAGIC_backref       '<' /* ??? */
+#define PERL_MAGIC_ext           '~' /* Available for use by extensions */
+
+
 #define YYMAXDEPTH 300
 
 #ifndef assert  /* <assert.h> might have been included somehow */
@@ -2310,7 +2390,7 @@ struct ufuncs {
     IV uf_index;
 };
 
-/* In pre-5.7-Perls the 'U' magic didn't get the thread context.
+/* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context.
  * XS code wanting to be backward compatible can do something
  * like the following:
 
@@ -2833,7 +2913,6 @@ enum {            /* pass one of these to get_vtbl */
 #define HINT_FILETEST_ACCESS   0x00400000
 #define HINT_UTF8              0x00800000
 #define HINT_UTF8_DISTINCT     0x01000000
-#define HINT_RE_ASCIIR         0x02000000
 
 /* Various states of an input record separator SV (rs, nrs) */
 #define RsSNARF(sv)   (! SvOK(sv))
@@ -3579,6 +3658,9 @@ typedef struct am_table_short AMTS;
 #ifdef IAMSUID
 
 #ifdef I_SYS_STATVFS
+#   if defined(PERL_SCO) && !defined(_SVID3)
+#       define _SVID3
+#   endif
 #   include <sys/statvfs.h>     /* for f?statvfs() */
 #endif
 #ifdef I_SYS_MOUNT