Stop filetest ops from calling FETCH on parent op’s arg

This is a regression in 5.14.0.

Commit 6f1401dc made ops call get-magic before overloading, but it
ended up making filetest ops call get-magic on the topmost item of the
stack even if the filetest op was not going to use the stack (which
happens for ‘-r bareword’ and plain ‘-r’).

This would affect cases like:

  push @foo, $tied, -r;

diff --git a/pp_sys.c b/pp_sys.c
index d6ca533..271edee 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2897,6 +2897,7 @@ PP(pp_stat)
 
 #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; \
     } STMT_END
@@ -2910,8 +2911,7 @@ S_try_amagic_ftest(pTHX_ char chr) {
     assert(chr != '?');
     SvGETMAGIC(arg);
 
-    if ((PL_op->op_flags & OPf_KIDS)
-           && SvAMAGIC(TOPs))
+    if (SvAMAGIC(TOPs))
     {
        const char tmpchr = chr;
        SV * const tmpsv = amagic_call(arg,

diff --git a/t/op/filetest.t b/t/op/filetest.t
index a6d62ed..08380d1 100644 (file)
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
-plan(tests => 29 + 27*14);
+plan(tests => 30 + 27*14);
 
 ok( -d 'op' );
 ok( -f 'TEST' );
@@ -204,3 +204,14 @@ for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
  push my @foo, "bar", -l baz;
  is $foo[0], "bar", '-l bareword does not corrupt the stack';
 }
+
+# File test ops should not call get-magic on the topmost SV on the stack if
+# it belongs to another op.
+{
+  my $w;
+  sub oon::TIESCALAR{bless[],'oon'}
+  sub oon::FETCH{$w++}
+  tie my $t, 'oon';
+  push my @a, $t, -t;
+  is $w, 1, 'file test does not call FETCH on stack item not its own';
+}