[perl.git] branch blead, updated. v5.13.4-225-g526fd1b

[Rafael Garcia-Suarez]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/526fd1b4d7270fff44588238f2411032c109da6e?hp=25222ff958727e01a3a480924b65ba188c7c3ea2>

- Log -----------------------------------------------------------------
commit 526fd1b4d7270fff44588238f2411032c109da6e
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Mon Sep 13 09:57:15 2010 +0200

    [perl #77684] Restore the 5.10/12 behaviour of open $fh, ">", \$glob_copy
    
    This restores the perl 5.10/12 behaviour, making open treat \$foo as a
    scalar reference if it is a glob copy (SvFAKE).
    
    It also fixes an existing assertion failure that the test now trig-
    gers. PerlIOScalar_pushed was not downgrading the sv before set-
    ting SvCUR.
-----------------------------------------------------------------------

Summary of changes:
 ext/PerlIO-scalar/scalar.xs |    7 +++++++
 perlio.c                    |    2 +-
 t/io/open.t                 |   12 +++++++++++-
 3 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index f2481f4..b93b9e9 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -47,9 +47,15 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * 
arg,
     SvUPGRADE(s->var, SVt_PV);
     code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
     if (!SvOK(s->var) || (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
+    {
+       sv_force_normal(s->var);
        SvCUR_set(s->var, 0);
+    }
     if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
+    {
+       sv_force_normal(s->var);
        s->posn = SvCUR(s->var);
+    }
     else
        s->posn = 0;
     SvSETMAGIC(s->var);
@@ -166,6 +172,7 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, 
Size_t count)
        SV *sv = s->var;
        char *dst;
        SvGETMAGIC(sv);
+       sv_force_normal(sv);
        if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
            dst = SvGROW(sv, SvCUR(sv) + count);
            offset = SvCUR(sv);
diff --git a/perlio.c b/perlio.c
index c83b2bb..79b7efa 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1449,7 +1449,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
     /*
      * For any scalar type load the handler which is bundled with perl
      */
-    if (SvTYPE(sv) < SVt_PVAV && !isGV_with_GP(sv)) {
+    if (SvTYPE(sv) < SVt_PVAV && (!isGV_with_GP(sv) || SvFAKE(sv))) {
        PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
        /* This isn't supposed to happen, since PerlIO::scalar is core,
         * but could happen anyway in smaller installs or with PAR */
diff --git a/t/io/open.t b/t/io/open.t
index 01bfaca..5bbcb0b 100644
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -10,7 +10,7 @@ $|  = 1;
 use warnings;
 use Config;
 
-plan tests => 110;
+plan tests => 111;
 
 my $Perl = which_perl();
 
@@ -337,3 +337,13 @@ fresh_perl_is(
     ',
     'ok', { stderr => 1 },
     '[perl #77492]: open $fh, ">", \*glob causes SEGV');
+
+# [perl #77684] Opening a reference to a glob copy.
+{
+    my $var = *STDOUT;
+    open my $fh, ">", \$var;
+    print $fh "hello";
+    is $var, "hello", '[perl #77684]: open $fh, ">", \$glob_copy'
+        # when this fails, it leaves an extra file:
+        or unlink \*STDOUT;
+}

--
Perl5 Master Repository