summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ext/PerlIO-scalar/scalar.xs7
-rw-r--r--perlio.c2
-rw-r--r--t/io/open.t12
3 files changed, 19 insertions, 2 deletions
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index f2481f4197..b93b9e9257 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 c83b2bb58e..79b7efae22 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 01bfaca73f..5bbcb0b59b 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;
+}