diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index 970091a2cb74..6f58f68e86dc 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -163,7 +163,8 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count) SV *sv = s->var; char *dst; SvGETMAGIC(sv); - sv_force_normal(sv); + if (SvROK(sv)) SvPV_force_nomg_nolen(sv); + else sv_force_normal(sv); if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) { dst = SvGROW(sv, SvCUR(sv) + count); offset = SvCUR(sv); diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index 4a026a4ec833..5763a470f9ff 100644 --- a/ext/PerlIO-scalar/t/scalar.t +++ b/ext/PerlIO-scalar/t/scalar.t @@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere. $| = 1; -use Test::More tests => 73; +use Test::More tests => 74; my $fh; my $var = "aaa\n"; @@ -285,12 +285,17 @@ EOF 'seek beyond end end of string followed by read'; } -# Writing to COW scalars +# Writing to COW scalars and refs { my $bovid = __PACKAGE__; open my $handel, ">", \$bovid; print $handel "the COW with the crumpled horn"; is $bovid, "the COW with the crumpled horn", 'writing to COW scalars'; + package lrcg { use overload fallback => 1, '""'=>sub { 'chin' } } + seek $handel, 3, 0; + $bovid = bless [], lrcg::; + print $handel 'mney'; + is $bovid, 'chimney', 'writing to refs'; } # [perl #92706]