From: Ben Morrow <ben@morrow.me.uk>
Date: Tue, 20 Jan 2009 01:29:50 +0000 (+0000)
Subject: Stacked overloaded -X.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7fb13887d71713a7821f3417b415917a61fdcf6c;p=p5sagit%2Fp5-mst-13.2.git

Stacked overloaded -X.
---

diff --git a/pp.h b/pp.h
index 50fec83..f3da1a7 100644
--- a/pp.h
+++ b/pp.h
@@ -473,6 +473,7 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 
 #define tryAMAGICftest(chr)				\
     STMT_START {					\
+	assert(chr != '?');				\
 	if (SvAMAGIC(TOPs)) {				\
 	    const char tmpchr = (chr);			\
 	    SV * const tmpsv = amagic_call(TOPs,	\
@@ -480,7 +481,19 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 		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;					\
 	    }						\
diff --git a/pp_sys.c b/pp_sys.c
index 374e5c1..1a8185a 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2986,18 +2986,26 @@ PP(pp_ftrread)
     char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTRREAD:	opchar = 'R'; break;
+    case OP_FTRWRITE:	opchar = 'W'; break;
+    case OP_FTREXEC:	opchar = 'X'; break;
+    case OP_FTEREAD:	opchar = 'r'; break;
+    case OP_FTEWRITE:	opchar = 'w'; break;
+    case OP_FTEEXEC:	opchar = 'x'; break;
+    }
+    tryAMAGICftest(opchar);
+
     STACKED_FTEST_CHECK;
 
     switch (PL_op->op_type) {
     case OP_FTRREAD:
-	opchar = 'R';
 #if !(defined(HAS_ACCESS) && defined(R_OK))
 	use_access = 0;
 #endif
 	break;
 
     case OP_FTRWRITE:
-	opchar = 'W';
 #if defined(HAS_ACCESS) && defined(W_OK)
 	access_mode = W_OK;
 #else
@@ -3007,7 +3015,6 @@ PP(pp_ftrread)
 	break;
 
     case OP_FTREXEC:
-	opchar = 'X';
 #if defined(HAS_ACCESS) && defined(X_OK)
 	access_mode = X_OK;
 #else
@@ -3017,19 +3024,13 @@ PP(pp_ftrread)
 	break;
 
     case OP_FTEWRITE:
-	opchar = 'w';
 #ifdef PERL_EFF_ACCESS
 	access_mode = W_OK;
 #endif
 	stat_mode = S_IWUSR;
-#ifndef PERL_EFF_ACCESS
-	use_access = 0;
-#endif
-	effective = TRUE;
-	break;
+	/* fall through */
 
     case OP_FTEREAD:
-	opchar = 'r';
 #ifndef PERL_EFF_ACCESS
 	use_access = 0;
 #endif
@@ -3037,7 +3038,6 @@ PP(pp_ftrread)
 	break;
 
     case OP_FTEEXEC:
-	opchar = 'x';
 #ifdef PERL_EFF_ACCESS
 	access_mode = X_OK;
 #else
@@ -3048,8 +3048,6 @@ PP(pp_ftrread)
 	break;
     }
 
-    tryAMAGICftest(opchar);
-
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
 	const char *name = POPpx;
@@ -3092,7 +3090,6 @@ PP(pp_ftis)
     const int op_type = PL_op->op_type;
     char opchar = '?';
     dSP;
-    STACKED_FTEST_CHECK;
 
     switch (op_type) {
     case OP_FTIS:	opchar = 'e'; break;
@@ -3103,6 +3100,8 @@ PP(pp_ftis)
     }
     tryAMAGICftest(opchar);
 
+    STACKED_FTEST_CHECK;
+
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3142,9 +3141,24 @@ PP(pp_ftrowned)
     char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTROWNED:	opchar = 'O'; break;
+    case OP_FTEOWNED:	opchar = 'o'; break;
+    case OP_FTZERO:	opchar = 'z'; break;
+    case OP_FTSOCK:	opchar = 'S'; break;
+    case OP_FTCHR:	opchar = 'c'; break;
+    case OP_FTBLK:	opchar = 'b'; break;
+    case OP_FTFILE:	opchar = 'f'; break;
+    case OP_FTDIR:	opchar = 'd'; break;
+    case OP_FTPIPE:	opchar = 'p'; break;
+    case OP_FTSUID:	opchar = 'u'; break;
+    case OP_FTSGID:	opchar = 'g'; break;
+    case OP_FTSVTX:	opchar = 'k'; break;
+    }
+    tryAMAGICftest(opchar);
+
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
-    if (!SvAMAGIC(TOPs)) {
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID)
 	RETPUSHNO;
@@ -3157,26 +3171,9 @@ PP(pp_ftrowned)
     if(PL_op->op_type == OP_FTSVTX)
 	RETPUSHNO;
 #endif
-    }
 
     STACKED_FTEST_CHECK;
 
-    switch (PL_op->op_type) {
-    case OP_FTROWNED:	opchar = 'O'; break;
-    case OP_FTEOWNED:	opchar = 'o'; break;
-    case OP_FTZERO:	opchar = 'z'; break;
-    case OP_FTSOCK:	opchar = 'S'; break;
-    case OP_FTCHR:	opchar = 'c'; break;
-    case OP_FTBLK:	opchar = 'b'; break;
-    case OP_FTFILE:	opchar = 'f'; break;
-    case OP_FTDIR:	opchar = 'd'; break;
-    case OP_FTPIPE:	opchar = 'p'; break;
-    case OP_FTSUID:	opchar = 'u'; break;
-    case OP_FTSGID:	opchar = 'g'; break;
-    case OP_FTSVTX:	opchar = 'k'; break;
-    }
-    tryAMAGICftest(opchar);
-
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3263,10 +3260,10 @@ PP(pp_fttty)
     GV *gv;
     SV *tmpsv = NULL;
 
-    STACKED_FTEST_CHECK;
-
     tryAMAGICftest('t');
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -3314,10 +3311,10 @@ PP(pp_fttext)
     GV *gv;
     PerlIO *fp;
 
-    STACKED_FTEST_CHECK;
-
     tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
     else if (isGV(TOPs))