X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/180b7b9bf7b919003df56bf402fc3934dc71f196..dd6c21bebf897e04754ff0d50210c6e54cc753c7:/pp.h

diff --git a/pp.h b/pp.h
index 5c25b55..f3da1a7 100644
--- a/pp.h
+++ b/pp.h
@@ -471,19 +471,33 @@ 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 {				    \
-	if (SvAMAGIC(TOPs)) {			    \
-	    SV * const tmpsv = amagic_call(TOPs,    \
-		newSVpvn_flags(&chr, 1, SVs_TEMP),  \
-		ftest_amg, 0);			    \
-						    \
-	    if (tmpsv) {			    \
-		SPAGAIN;			    \
-		SETs(tmpsv);			    \
-		RETURN;				    \
-	    }					    \
-	}					    \
+#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