X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.h;h=9d078af5e5dd6070de123c00b999c1d5160c9a95;hb=021f53de09926928546378b3552f9240c9241dde;hp=7b5f322f1c02fbfc3ff512345dd10f99f929e576;hpb=8f14ea018e8d1f6c6a67be29ee2ae899993d0f0e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.h b/pp.h
index 7b5f322..9d078af 100644
--- a/pp.h
+++ b/pp.h
@@ -1,7 +1,7 @@
 /*    pp.h
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000,
- *    2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+ *    2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -86,7 +86,7 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 #define dTARG SV *targ
 
 #define NORMAL PL_op->op_next
-#define DIE return Perl_die
+#define DIE Perl_die
 
 /*
 =for apidoc Ams||PUTBACK
@@ -471,6 +471,36 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #define tryAMAGICunDEREF_var(meth_enum) \
 	tryAMAGICunW_var(meth_enum,setAGAIN,0,(void)0)
 
+#define tryAMAGICftest(chr)				\
+    STMT_START {					\
+	assert(chr != '?');				\
+	if (SvAMAGIC(TOPs)) {				\
+	    const char tmpchr = (chr);			\
+	    SV * const tmpsv = amagic_call(TOPs,	\
+		newSVpvn_flags(&tmpchr, 1, SVs_TEMP),	\
+		ftest_amg, AMGf_unary);			\
+							\
+	    if (tmpsv) {				\
+		const OP *next = PL_op->op_next;	\
+							\
+		SPAGAIN;				\
+							\
+		if (next->op_type >= OP_FTRREAD &&	\
+		    next->op_type <= OP_FTBINARY &&	\
+		    next->op_private & OPpFT_STACKED	\
+		) {					\
+		    if (SvTRUE(tmpsv))			\
+			/* leave the object alone */	\
+			RETURN;				\
+		}					\
+							\
+		SETs(tmpsv);				\
+		RETURN;					\
+	    }						\
+	}						\
+    } STMT_END
+
+
 #define opASSIGN (PL_op->op_flags & OPf_STACKED)
 #define SETsv(sv)	STMT_START {					\
 		if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY))		\
@@ -487,9 +517,9 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 
 /* SV* ref causes confusion with the member variable
    changed SV* ref to SV* tmpRef */
-#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv);      \
-  if (SvREFCNT(tmpRef)>1) {                 \
-    SvRV_set(rv, AMG_CALLun(rv,copy));	\
+#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); SV* rv_copy;     \
+  if (SvREFCNT(tmpRef)>1 && (rv_copy = AMG_CALLun(rv,copy))) {          \
+    SvRV_set(rv, rv_copy);		    \
     SvREFCNT_dec(tmpRef);                   \
   } } STMT_END
 
@@ -500,6 +530,15 @@ True if this op will be the return value of an lvalue subroutine
 =cut */
 #define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())
 
+#define SvCANEXISTDELETE(sv) \
+ (!SvRMAGICAL(sv)            \
+  || ((mg = mg_find((const SV *) sv, PERL_MAGIC_tied))           \
+      && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \
+      && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)          \
+      && gv_fetchmethod_autoload(stash, "DELETE", TRUE)          \
+     )                       \
+  )
+
 /*
  * Local variables:
  * c-indentation-style: bsd