diff options
| -rw-r--r-- | pp.h | 13 | ||||
| -rw-r--r-- | pp_sys.c | 69 |
2 files changed, 46 insertions, 36 deletions
@@ -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; \ } \ @@ -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)) |