Re: [perl.git] branch blead, updated. v5.15.2-280-g9356472

On Fri, Sep 09, 2011 at 03:04:34AM +0200, Father Chrysostomos wrote:
> In perl.git, the branch blead has been updated
> 
> <http://perl5.git.perl.org/perl.git/commitdiff/935647290357b277a54366c3caf2ddc89bfbd3eb?hp=a9feb6cb11fbf4270519aa7318b89f5becccd87c>
> 
> - Log -----------------------------------------------------------------
> commit 935647290357b277a54366c3caf2ddc89bfbd3eb
> Author: Father Chrysostomos <sprout@cpan.org>
> Date:   Thu Sep 8 18:03:02 2011 -0700
> 
>     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.
> 
> M	doio.c
> M	pod/perldelta.pod
> M	pp_sys.c
> M	t/op/tie_fetch_count.t

chdir, chmod and chown also accept references to typeglobs, so is this also
needed?

Nicholas Clark

From 96267e4d0449db35c258f0fdc0f7df86de2880af Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 9 Sep 2011 17:04:53 +0200
Subject: [PATCH] chdir and chmod should also call FETCH on references to tied globs.

Following on from commit 935647290357b277, which corrected the behaviour
for tied globs, this commit corrects the behaviour for references to tied
globs.

Also improve error diagnostics by reporting the caller's line number if
check_count() fails, and correct a thinko in a test description.
---
 doio.c                 |   15 ++++++++++-----
 pp_sys.c               |   15 +++++++++++----
 t/op/tie_fetch_count.t |   11 +++++++++--
 3 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/doio.c b/doio.c
index 7cb0096..3aef7fc 100644
--- a/doio.c
+++ b/doio.c
@@ -1636,12 +1636,17 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 			tot--;
 		    }
 		}
-		else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
-		    gv = MUTABLE_GV(SvRV(*mark));
-		    goto do_fchmod;
-		}
 		else {
-		    const char *name = SvPV_nomg_const_nolen(*mark);
+		    const char *name;
+		    if (SvROK(*mark)) {
+			SV *const sv = SvRV(*mark);
+			SvGETMAGIC(sv);
+			if isGV_with_GP(sv) {
+				gv = MUTABLE_GV(sv);
+				goto do_fchmod;
+			    }
+		    }
+		    name = SvPV_nomg_const_nolen(*mark);
 		    APPLY_TAINT_PROPER();
 		    if (PerlLIO_chmod(name, val))
 			tot--;
diff --git a/pp_sys.c b/pp_sys.c
index e92d13d..f6b4ab6 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3471,11 +3471,18 @@ PP(pp_chdir)
 	    if(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_nomg_const_nolen(sv);
+		if (SvROK(sv)) {
+		    SV *const maybe_gv = SvRV(sv);
+		    SvGETMAGIC(maybe_gv);
+		    if (isGV_with_GP(maybe_gv)) {
+			/* This is the gv we are looking for.  */
+			gv = MUTABLE_GV(maybe_gv);
+		    }
+		}
+		if (!gv) {
+		    tmps = SvPV_nomg_const_nolen(sv);
+		}
 	    }
 	}
     }
diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 5903377..fe4df6d 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 => 223);
+    plan (tests => 226);
 }
 
 use strict;
@@ -28,6 +28,7 @@ sub STORE { unshift @{$_[0]}, $_[1] }
 sub check_count {
     my $op = shift;
     my $expected = shift() // 1;
+    local $::Level = $::Level + 1;
     is $count, $expected,
         "FETCH called " . (
           $expected == 1 ? "just once" : 
@@ -221,9 +222,15 @@ $var8->bolgy            ; check_count '->method';
 $var8 = *dummy; $dummy = $var8; $count = 0;
 eval { chdir $var8 }    ; check_count 'chdir $tied_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';
+eval { chmod 0, \$var8 } ; check_count 'chmod 0,\$tied_glob';
+$var8 = *dummy; $dummy = $var8; $count = 0;
+eval { chown 0,0,$var8 }; check_count 'chown 0,$tied_glob';
+$var8 = *dummy; $dummy = $var8; $count = 0;
+eval { chown 0,0,$var8 }; check_count 'chown 0,\$tied_glob';
 
 
 ###############################################
-- 
1.5.6.5

• Re: [perl.git] branch blead, updated. v5.15.2-280-g9356472 by Nicholas Clark
• Re: [perl.git] branch blead, updated. v5.15.2-280-g9356472 by Father Chrysostomos