diff options
| -rw-r--r-- | doio.c | 7 | ||||
| -rw-r--r-- | pp.h | 6 | ||||
| -rw-r--r-- | pp_sys.c | 13 | ||||
| -rw-r--r-- | t/op/tie_fetch_count.t | 37 |
4 files changed, 17 insertions, 46 deletions
@@ -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) { @@ -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 @@ -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 b62f66d1bc..b69ee9f98d 100644 --- 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"; |