[perl #77388] Make stacked -t work

Up till now, -t was popping too much off the stack when stacked with
other filetest operators.

Since the special use of _ doesn’t apply to -t, we cannot simply have
it use _ when stacked, but instead we pass the argument down from the
previous op.

To facilitate this, the whole stacked mechanism has to change.

As before, in an expression like -r -w -x, -x  and -w are flagged
as ‘stacking’ ops (followed by another filetest), and -w and -r are
flagged as stacked (preceded by another filetest).

Stacking filetest ops no longer return a false value to the next op
when a test fails, and stacked ops no longer check the truth of the
value on the stack to determine whether to return early (if it’s
false).

The argument to the first filetest is now passed from one op to
another.  This is similar to the mechanism that overloaded objects
were already using.  Now it applies to any argument.

Since it could be false, we cannot rely on the boolean value of the
stack item.  So, stacking ops, when they return false, now traverse
the ->op_next pointers and find the op after the last stacked op.
That op is returned to the runloop.  This short-circuiting is proba-
bly faster than calling every subsequent op (a separate function call
for each).

Filetest ops other than -t continue to use the last stat buffer when
stacked, so the argument on the stack is ignored.

But if the op is preceded by nothing other than -t (where preceded
means on the right, since the ops are evaluated right-to-left), it
*does* use the argument on the stack, since -t has not set the last
stat buffer.

The new OPpFT_AFTER_t flag indicates that a stacked op is preceded by
nothing other than -t.

In ‘-e -t foo’, the -e gets the flag, but not in ‘-e -t -r foo’,
because -r will have saved the stat buffer, so -e can just use that.

diff --git a/doio.c b/doio.c
index 08a15b7..081fdf2 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1292,14 +1292,15 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        report_evil_fh(gv);
        return -1;
     }
-    else if (PL_op->op_private & OPpFT_STACKED) {
-       return PL_laststatval;
-    }
     else {
-       SV* const sv = POPs;
+      SV* const sv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
+      PUTBACK;
+      if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+            == OPpFT_STACKED)
+       return PL_laststatval;
+      else {
        const char *s;
        STRLEN len;
-       PUTBACK;
        if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
            goto do_fstat;
        }
@@ -1318,6 +1319,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
        return PL_laststatval;
+      }
     }
 }
 
@@ -1345,7 +1347,10 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
        }
        return -1;
     }
-    else if (PL_op->op_private & OPpFT_STACKED) {
+    sv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
+    PUTBACK;
+    if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+            == OPpFT_STACKED) {
       if (PL_laststype != OP_LSTAT)
        Perl_croak(aTHX_ no_prev_lstat);
       return PL_laststatval;
@@ -1353,8 +1358,6 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;
-    sv = POPs;
-    PUTBACK;
     file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 992596a..476b949 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -652,7 +652,7 @@ $priv{$_}{2} = "FTACCESS"
 @{$priv{"entereval"}}{2,4,8,16} = qw "HAS_HH UNI BYTES COPHH";
 if ($] >= 5.009) {
   # Stacked filetests are post 5.8.x
-  @{$priv{$_}}{4,8} = ("FTSTACKED","FTSTACKING")
+  @{$priv{$_}}{4,8,16} = ("FTSTACKED","FTSTACKING","FTAFTERt")
     for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
          "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
         "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",

diff --git a/op.c b/op.c
index 72232ea..3af6ee7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7741,6 +7741,11 @@ Perl_ck_ftst(pTHX_ OP *o)
                && kidtype != OP_STAT && kidtype != OP_LSTAT) {
            o->op_private |= OPpFT_STACKED;
            kid->op_private |= OPpFT_STACKING;
+           if (kidtype == OP_FTTTY && (
+                  !(kid->op_private & OPpFT_STACKED)
+               || kid->op_private & OPpFT_AFTER_t
+              ))
+               o->op_private |= OPpFT_AFTER_t;
        }
     }
     else {

diff --git a/op.h b/op.h
index ffa9a3f..f2b5b61 100644 (file)
--- a/op.h
+++ b/op.h
@@ -295,6 +295,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpFT_ACCESS           2       /* use filetest 'access' */
 #define OPpFT_STACKED          4       /* stacked filetest, as "-f" in "-f -x $f" */
 #define OPpFT_STACKING         8       /* stacking filetest, as "-x" in "-f -x $f" */
+#define OPpFT_AFTER_t          16      /* previous op was -t */
 
 /* Private for OP_(MAP|GREP)(WHILE|START) */
 #define OPpGREP_LEX            2       /* iterate over lexical $_ */

diff --git a/pp_sys.c b/pp_sys.c
index 20a34ac..47c8a35 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2895,14 +2895,54 @@ PP(pp_stat)
     RETURN;
 }
 
+/* If the next filetest is stacked up with this one
+   (PL_op->op_private & OPpFT_STACKING), we leave
+   the original argument on the stack for success,
+   and skip the stacked operators on failure.
+   The next few macros/functions take care of this.
+*/
+
+static OP *
+S_ft_stacking_return_false(pTHX_ SV *ret) {
+    dSP;
+    OP *next = NORMAL;
+    while (OP_IS_FILETEST(next->op_type)
+       && next->op_private & OPpFT_STACKED)
+       next = next->op_next;
+    if (PL_op->op_flags & OPf_REF) PUSHs(ret);
+    else                          SETs(ret);
+    PUTBACK;
+    return next;
+}
+
+#define FT_RETURN_FALSE(X)                          \
+    STMT_START {                                     \
+       if (PL_op->op_private & OPpFT_STACKING)        \
+           return S_ft_stacking_return_false(aTHX_ X); \
+       RETURNX(PUSHs(X));                               \
+    } STMT_END
+#define FT_RETURN_TRUE(X)               \
+    RETURNX((void)(                      \
+       PL_op->op_private & OPpFT_STACKING \
+           ? PL_op->op_flags & OPf_REF     \
+               ? PUSHs((SV *)cGVOP_gv)      \
+               : 0                           \
+           : PUSHs(X)                         \
+    ))
+
+#define FT_RETURNNO    FT_RETURN_FALSE(&PL_sv_no)
+#define FT_RETURNUNDEF FT_RETURN_FALSE(&PL_sv_undef)
+#define FT_RETURNYES   FT_RETURN_TRUE(&PL_sv_yes)
+
 #define tryAMAGICftest_MG(chr) STMT_START { \
        if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
-               && PL_op->op_flags & OPf_KIDS    \
-               && S_try_amagic_ftest(aTHX_ chr)) \
-           return NORMAL; \
+               && PL_op->op_flags & OPf_KIDS) {     \
+           OP *next = S_try_amagic_ftest(aTHX_ chr);   \
+           if (next) return next;                        \
+       }                                                  \
     } STMT_END
 
-STATIC bool
+STATIC OP *
 S_try_amagic_ftest(pTHX_ char chr) {
     dVAR;
     dSP;
@@ -2919,33 +2959,17 @@ S_try_amagic_ftest(pTHX_ char chr) {
                                ftest_amg, AMGf_unary);
 
        if (!tmpsv)
-           return FALSE;
+           return NULL;
 
        SPAGAIN;
 
-       if (PL_op->op_private & OPpFT_STACKING) {
-           if (SvTRUE(tmpsv))
-               /* leave the object alone */
-               return TRUE;
-       }
-
-       SETs(tmpsv);
-       PUTBACK;
-       return TRUE;
+       if (SvTRUE(tmpsv)) FT_RETURN_TRUE(tmpsv);
+       FT_RETURN_FALSE(tmpsv);
     }
-    return FALSE;
+    return NULL;
 }
 
 
-/* This macro is used by the stacked filetest operators :
- * if the previous filetest failed, short-circuit and pass its value.
- * Else, discard it from the stack and continue. --rgs
- */
-#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
-       if (!SvTRUE(TOPs)) { RETURN; } \
-       else { (void)POPs; PUTBACK; } \
-    }
-
 PP(pp_ftrread)
 {
     dVAR;
@@ -2981,8 +3005,6 @@ PP(pp_ftrread)
     }
     tryAMAGICftest_MG(opchar);
 
-    STACKED_FTEST_CHECK;
-
     switch (PL_op->op_type) {
     case OP_FTRREAD:
 #if !(defined(HAS_ACCESS) && defined(R_OK))
@@ -3062,10 +3084,10 @@ PP(pp_ftrread)
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (cando(stat_mode, effective, &PL_statcache))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 PP(pp_ftis)
@@ -3085,14 +3107,12 @@ PP(pp_ftis)
     }
     tryAMAGICftest_MG(opchar);
 
-    STACKED_FTEST_CHECK;
-
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (op_type == OP_FTIS)
-       RETPUSHYES;
+       FT_RETURNYES;
     {
        /* You can't dTARGET inside OP_FTIS, because you'll get
           "panic: pad_sv po" - the op is not flagged to have a target.  */
@@ -3100,23 +3120,28 @@ PP(pp_ftis)
        switch (op_type) {
        case OP_FTSIZE:
 #if Off_t_size > IVSIZE
-           PUSHn(PL_statcache.st_size);
+           sv_setnv(TARG, (NV)PL_statcache.st_size);
 #else
-           PUSHi(PL_statcache.st_size);
+           sv_setiv(TARG, (IV)PL_statcache.st_size);
 #endif
            break;
        case OP_FTMTIME:
-           PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_mtime) / 86400.0 );
            break;
        case OP_FTATIME:
-           PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_atime) / 86400.0 );
            break;
        case OP_FTCTIME:
-           PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_ctime) / 86400.0 );
            break;
        }
+       SvSETMAGIC(TARG);
+       if (SvTRUE_nomg(TARG)) FT_RETURN_TRUE(TARG);
+       else                   FT_RETURN_FALSE(TARG);
     }
-    RETURN;
 }
 
 PP(pp_ftrowned)
@@ -3142,93 +3167,91 @@ PP(pp_ftrowned)
     }
     tryAMAGICftest_MG(opchar);
 
-    STACKED_FTEST_CHECK;
-
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID) {
-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #endif
 #ifndef S_ISGID
     if(PL_op->op_type == OP_FTSGID) {
-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #endif
 #ifndef S_ISVTX
     if(PL_op->op_type == OP_FTSVTX) {
-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #endif
 
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     switch (PL_op->op_type) {
     case OP_FTROWNED:
        if (PL_statcache.st_uid == PL_uid)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTEOWNED:
        if (PL_statcache.st_uid == PL_euid)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTZERO:
        if (PL_statcache.st_size == 0)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTSOCK:
        if (S_ISSOCK(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTCHR:
        if (S_ISCHR(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTBLK:
        if (S_ISBLK(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTFILE:
        if (S_ISREG(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTDIR:
        if (S_ISDIR(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTPIPE:
        if (S_ISFIFO(PL_statcache.st_mode))
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #ifdef S_ISUID
     case OP_FTSUID:
        if (PL_statcache.st_mode & S_ISUID)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #endif
 #ifdef S_ISGID
     case OP_FTSGID:
        if (PL_statcache.st_mode & S_ISGID)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #endif
 #ifdef S_ISVTX
     case OP_FTSVTX:
        if (PL_statcache.st_mode & S_ISVTX)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #endif
     }
-    RETPUSHNO;
+    FT_RETURNNO;
 }
 
 PP(pp_ftlink)
@@ -3238,15 +3261,14 @@ PP(pp_ftlink)
     I32 result;
 
     tryAMAGICftest_MG('l');
-    STACKED_FTEST_CHECK;
     result = my_lstat_flags(0);
     SPAGAIN;
 
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (S_ISLNK(PL_statcache.st_mode))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 PP(pp_fttty)
@@ -3260,12 +3282,10 @@ PP(pp_fttty)
 
     tryAMAGICftest_MG('t');
 
-    STACKED_FTEST_CHECK;
-
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     else {
-      SV *tmpsv = POPs;
+      SV *tmpsv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
       if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {
        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
@@ -3277,10 +3297,10 @@ PP(pp_fttty)
     else if (name && isDIGIT(*name))
            fd = atoi(name);
     else
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (PerlLIO_isatty(fd))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 #if defined(atarist) /* this will work with atariST. Configure will
@@ -3307,16 +3327,18 @@ PP(pp_fttext)
 
     tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
-    STACKED_FTEST_CHECK;
-
     if (PL_op->op_flags & OPf_REF)
     {
        gv = cGVOP_gv;
        EXTEND(SP, 1);
     }
-    else if (PL_op->op_private & OPpFT_STACKED)
+    else {
+      sv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
+      if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+            == OPpFT_STACKED)
        gv = PL_defgv;
-    else sv = POPs, gv = MAYBE_DEREF_GV_nomg(sv);
+      else gv = MAYBE_DEREF_GV_nomg(sv);
+    }
 
     if (gv) {
        if (gv == PL_defgv) {
@@ -3340,12 +3362,12 @@ PP(pp_fttext)
                DIE(aTHX_ "-T and -B not implemented on filehandles");
            PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
            if (PL_laststatval < 0)
-               RETPUSHUNDEF;
+               FT_RETURNUNDEF;
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
                if (PL_op->op_type == OP_FTTEXT)
-                   RETPUSHNO;
+                   FT_RETURNNO;
                else
-                   RETPUSHYES;
+                   FT_RETURNYES;
             }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
                i = PerlIO_getc(IoIFP(io));
@@ -3353,7 +3375,7 @@ PP(pp_fttext)
                    (void)PerlIO_ungetc(IoIFP(io),i);
            }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */
-               RETPUSHYES;
+               FT_RETURNYES;
            len = PerlIO_get_bufsiz(IoIFP(io));
            s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
            /* sfio can have large buffers - limit to 512 */
@@ -3364,7 +3386,7 @@ PP(pp_fttext)
            SETERRNO(EBADF,RMS_IFI);
            report_evil_fh(gv);
            SETERRNO(EBADF,RMS_IFI);
-           RETPUSHUNDEF;
+           FT_RETURNUNDEF;
        }
     }
     else {
@@ -3379,21 +3401,21 @@ PP(pp_fttext)
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
                                               '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
-           RETPUSHUNDEF;
+           FT_RETURNUNDEF;
        }
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);
-           RETPUSHUNDEF;
+           FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
        len = PerlIO_read(fp, tbuf, sizeof(tbuf));
        (void)PerlIO_close(fp);
        if (len <= 0) {
            if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
-               RETPUSHNO;              /* special case NFS directories */
-           RETPUSHYES;         /* null file is anything */
+               FT_RETURNNO;            /* special case NFS directories */
+           FT_RETURNYES;               /* null file is anything */
        }
        s = tbuf;
     }
@@ -3447,9 +3469,9 @@ PP(pp_fttext)
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
-       RETPUSHNO;
+       FT_RETURNNO;
     else
-       RETPUSHYES;
+       FT_RETURNYES;
 }
 
 /* File calls. */

diff --git a/t/op/filetest_stack_ok.t b/t/op/filetest_stack_ok.t
index c89428c..6be383a 100644 (file)
--- a/t/op/filetest_stack_ok.t
+++ b/t/op/filetest_stack_ok.t
@@ -36,10 +36,6 @@ for my $op (@ops) {
            $t = eval "-$op -e \$^X" ? 0 : "bar";
        }
        elsif ($count == 1) {
-           local $TODO;
-           if ($op eq 't') {
-               $TODO = "[perl #77388] stacked file test does not work with -$op";
-           }
            is($m, "d", "-$op -e \$^X did not remove too many values from the stack");
        }
        $count++;

diff --git a/t/op/filetest_t.t b/t/op/filetest_t.t
index 3508564..cd552a7 100644 (file)
--- a/t/op/filetest_t.t
+++ b/t/op/filetest_t.t
@@ -8,7 +8,7 @@ BEGIN {
 
 use strict;
 
-plan 2;
+plan 7;
 
 my($dev_tty, $dev_null) = qw(/dev/tty /dev/null);
   ($dev_tty, $dev_null) = qw(con      nul      ) if $^O =~ /^(MSWin32|os2)$/;
@@ -23,9 +23,16 @@ SKIP: {
         skip("'$tt_dev' is probably not a terminal") if $tt_dev !~ m/^_(tt|ft|rt)/i;
     }
     ok(-t $tty, "'$dev_tty' is a TTY");
+    ok(-t -e $tty, "'$dev_tty' is a TTY (with -t -e)");
+    -e 'mehyparchonarcheion'; # clear last stat buffer
+    ok(-e -t $tty, "'$dev_tty' is a TTY (with -e -t)");
+    -e 'mehyparchonarcheion';
+    ok(-e -t -t $tty, "'$dev_tty' is a TTY (with -e -t -t)");
 }
 SKIP: {
     open(my $null, "<", $dev_null)
        or skip("Can't open null device '$dev_null': $!");
     ok(!-t $null, "'$dev_null' is not a TTY");
+    ok(!-t -e $null, "'$dev_null' is not a TTY (with -t -e)");
+    ok(!-e -t $null, "'$dev_null' is not a TTY (with -e -t)");
 }