Skip to content

Commit

Permalink
[perl #77684] Restore the 5.10/12 behaviour of open $fh, ">", \$glob_…
Browse files Browse the repository at this point in the history
…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.
  • Loading branch information
Father Chrysostomos authored and rgs committed Sep 13, 2010
1 parent 25222ff commit 526fd1b
Show file tree
Hide file tree
Showing 3 changed files with 19 additions and 2 deletions.
7 changes: 7 additions & 0 deletions ext/PerlIO-scalar/scalar.xs
Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down
2 changes: 1 addition & 1 deletion perlio.c
Expand Up @@ -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 */
Expand Down
12 changes: 11 additions & 1 deletion t/io/open.t
Expand Up @@ -10,7 +10,7 @@ $| = 1;
use warnings;
use Config;

plan tests => 110;
plan tests => 111;

my $Perl = which_perl();

Expand Down Expand Up @@ -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;
}

0 comments on commit 526fd1b

Please sign in to comment.