ch(dir|mod|own) should not ignore get-magic on glob(ref)s

When the chdir(*handle) feature was added in 5.8.8, the fact that
globs and refs could be magical was not taken into account.

They can easily be magical if a typeglob or reference is returned from
or assigned to a tied variable.

diff --git a/doio.c b/doio.c
index cecc574..7cb0096 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1619,6 +1619,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            tot = sp - mark;
            while (++mark <= sp) {
                 GV* gv;
+                SvGETMAGIC(*mark);
                 if (isGV_with_GP(*mark)) {
                     gv = MUTABLE_GV(*mark);
                do_fchmod:
@@ -1640,7 +1641,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
                    goto do_fchmod;
                }
                else {
-                   const char *name = SvPV_nolen_const(*mark);
+                   const char *name = SvPV_nomg_const_nolen(*mark);
                    APPLY_TAINT_PROPER();
                    if (PerlLIO_chmod(name, val))
                        tot--;
@@ -1659,6 +1660,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            tot = sp - mark;
            while (++mark <= sp) {
                 GV* gv;
+                SvGETMAGIC(*mark);
                 if (isGV_with_GP(*mark)) {
                     gv = MUTABLE_GV(*mark);
                do_fchown:
@@ -1680,7 +1682,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
                    goto do_fchown;
                }
                else {
-                   const char *name = SvPV_nolen_const(*mark);
+                   const char *name = SvPV_nomg_const_nolen(*mark);
                    APPLY_TAINT_PROPER();
                    if (PerlLIO_chown(name, val, val2))
                        tot--;

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index f527418..bb5907f 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -546,6 +546,13 @@ equivalent to C<setpgrp($foo,0)>.
 Assignments like C<*$tied = \&{"..."}> and C<*glob = $tied> now call FETCH
 only once.
 
+=item *
+
+C<chdir>, C<chmod> and C<chown> now always call FETCH if passed a tied
+variable as the last argument.  They used to ignore tiedness if the last
+thing return from or assigned to the variable was a typeglob or reference
+to a typeglob.
+
 =back
 
 =head1 Known Problems

diff --git a/pp_sys.c b/pp_sys.c
index ccc4325..8666a91 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3466,14 +3466,14 @@ PP(pp_chdir)
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);
        }
-        else if (isGV_with_GP(sv)) {
+        else if (SvGETMAGIC(sv), isGV_with_GP(sv)) {
            gv = MUTABLE_GV(sv);
         }
        else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
             gv = MUTABLE_GV(SvRV(sv));
         }
         else {
-           tmps = SvPV_nolen_const(sv);
+           tmps = SvPV_nomg_const_nolen(sv);
        }
     }
 

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 41d7308..5903377 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 => 220);
+    plan (tests => 223);
 }
 
 use strict;
@@ -43,10 +43,7 @@ tie my $var => 'main', 1;
 
 # Assignment.
 $dummy  =  $var         ; check_count "=";
-{
-    no warnings 'once';
-    *dummy  =  $var         ; check_count '*glob = $tied';
-}
+*dummy  =  $var         ; check_count '*glob = $tied';
 
 # Unary +/-
 $dummy  = +$var         ; check_count "unary +";
@@ -220,6 +217,15 @@ $var8->bolgy            ; check_count '->method';
     *$var9 = \&{"glumscrin"}; check_count '*$tied = \&{"name of const"}';
 }
 
+# This line makes $var8 hold a glob:
+$var8 = *dummy; $dummy = $var8; $count = 0;
+eval { chdir $var8 }    ; check_count 'chdir $tied_glob';
+$var8 = *dummy; $dummy = $var8; $count = 0;
+eval { chmod 0, $var8 } ; check_count 'chmod 0,$tied_glob';
+$var8 = *dummy; $dummy = $var8; $count = 0;
+eval { chown 0,0,$var8 }; check_count 'chmod 0,$tied_glob';
+
+
 ###############################################
 #        Tests for  $foo binop $foo           #
 ###############################################