X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.h;h=9d078af5e5dd6070de123c00b999c1d5160c9a95;hb=f13b7ac8b084674447e000c42d094f46b04c5dd7;hp=118c0272019ede94970e5b1a9feb5ca6f2f39f86;hpb=d30e492cced9a7022652176a253f8f900679d9b0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.h b/pp.h
index 118c027..9d078af 100644
--- a/pp.h
+++ b/pp.h
@@ -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))		\