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