Make filetest ops handle get-magic correctly for glob(ref)s

This patch uses the recently-added MAYBE_DEREF_GV macro which puts the
glob deref logic in one spot.  It also adds _nomg and _flags varia-
tions of it.  _flags understands the SV_GMAGIC flag.

diff --git a/doio.c b/doio.c
index 1ce6acc..6b5300c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1299,12 +1299,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        const char *s;
        STRLEN len;
        PUTBACK;
-       if (isGV_with_GP(sv)) {
-           gv = MUTABLE_GV(sv);
-           goto do_fstat;
-       }
-       else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
-           gv = MUTABLE_GV(SvRV(sv));
+       if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
            goto do_fstat;
        }
         else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {

diff --git a/pp.h b/pp.h
index 23636cc..ad71668 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -505,9 +505,9 @@ True if this op will be the return value of an lvalue subroutine
 #  define TIED_METHOD_SAY                      0x10
 
 /* Used in various places that need to dereference a glob or globref */
-#  define MAYBE_DEREF_GV(sv)                                       \
+#  define MAYBE_DEREF_GV_flags(sv,phlags)                          \
     (                                                               \
-       SvGETMAGIC(sv),                                              \
+       (void)(phlags & SV_GMAGIC && (SvGETMAGIC(sv),0)),            \
        isGV_with_GP(sv)                                              \
          ? (GV *)sv                                                   \
          : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV &&               \
@@ -515,6 +515,8 @@ True if this op will be the return value of an lvalue subroutine
             ? (GV *)SvRV(sv)                                            \
             : NULL                                                       \
     )
+#  define MAYBE_DEREF_GV(sv)      MAYBE_DEREF_GV_flags(sv,SV_GMAGIC)
+#  define MAYBE_DEREF_GV_nomg(sv) MAYBE_DEREF_GV_flags(sv,0)
 
 #endif
 

diff --git a/pp_sys.c b/pp_sys.c
index 50c1a12..d6ca533 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3264,11 +3264,7 @@ PP(pp_fttty)
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else if (isGV_with_GP(TOPs))
-       gv = MUTABLE_GV(POPs);
-    else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
-       gv = MUTABLE_GV(SvRV(POPs));
-    else {
+    else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) {
        tmpsv = POPs;
        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
@@ -3317,12 +3313,7 @@ PP(pp_fttext)
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else if (isGV_with_GP(TOPs))
-       gv = MUTABLE_GV(POPs);
-    else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
-       gv = MUTABLE_GV(SvRV(POPs));
-    else
-       gv = NULL;
+    else gv = MAYBE_DEREF_GV_nomg(TOPs);
 
     if (gv) {
        EXTEND(SP, 1);

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index b62f66d..b69ee9f 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 226);
+    plan (tests => 278);
 }
 
 use strict;
@@ -119,33 +119,16 @@ $dummy  = <$var0>       ; check_count '<readline>';
 $dummy  = <${var}>      ; check_count '<glob>';
 
 # File operators
-$dummy  = -r $var       ; check_count '-r';
-$dummy  = -w $var       ; check_count '-w';
-$dummy  = -x $var       ; check_count '-x';
-$dummy  = -o $var       ; check_count '-o';
-$dummy  = -R $var       ; check_count '-R';
-$dummy  = -W $var       ; check_count '-W';
-$dummy  = -X $var       ; check_count '-X';
-$dummy  = -O $var       ; check_count '-O';
-$dummy  = -e $var       ; check_count '-e';
-$dummy  = -z $var       ; check_count '-z';
-$dummy  = -s $var       ; check_count '-s';
-$dummy  = -f $var       ; check_count '-f';
-$dummy  = -d $var       ; check_count '-d';
+for (split //, 'rwxoRWXOezsfdpSbctugkTBMAC') {
+    no warnings 'unopened';
+    $dummy  = eval "-$_ \$var"; check_count "-$_";
+    # Make $var hold a glob:
+    $var = *dummy; $dummy = $var; $count = 0;
+    $dummy  = eval "-$_ \$var"; check_count "-$_ \$tied_glob";
+    $var = *dummy; $dummy = $var; $count = 0;
+    $dummy  = eval "-$_ \\\$var"; check_count "-$_ \\\$tied_glob";
+}
 $dummy  = -l $var       ; check_count '-l';
-$dummy  = -p $var       ; check_count '-p';
-$dummy  = -S $var       ; check_count '-S';
-$dummy  = -b $var       ; check_count '-b';
-$dummy  = -c $var       ; check_count '-c';
-$dummy  = -t $var       ; check_count '-t';
-$dummy  = -u $var       ; check_count '-u';
-$dummy  = -g $var       ; check_count '-g';
-$dummy  = -k $var       ; check_count '-k';
-$dummy  = -T $var       ; check_count '-T';
-$dummy  = -B $var       ; check_count '-B';
-$dummy  = -M $var       ; check_count '-M';
-$dummy  = -A $var       ; check_count '-A';
-$dummy  = -C $var       ; check_count '-C';
 
 # Matching
 $_ = "foo";