diff options
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/PerlIO/scalar/scalar.xs | 5 | ||||
| -rw-r--r-- | ext/PerlIO/t/scalar.t | 43 |
2 files changed, 45 insertions, 3 deletions
diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs index 2c8eacdcff..5828a550db 100644 --- a/ext/PerlIO/scalar/scalar.xs +++ b/ext/PerlIO/scalar/scalar.xs @@ -31,8 +31,9 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, return -1; } s->var = SvREFCNT_inc(SvRV(arg)); - if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL) - (void)SvPV_nolen(s->var); + SvGETMAGIC(s->var); + if (!SvPOK(s->var) && SvOK(s->var)) + (void)SvPV_nomg_const_nolen(s->var); } else { s->var = diff --git a/ext/PerlIO/t/scalar.t b/ext/PerlIO/t/scalar.t index 81c9277014..393ce0d375 100644 --- a/ext/PerlIO/t/scalar.t +++ b/ext/PerlIO/t/scalar.t @@ -18,7 +18,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere. $| = 1; -use Test::More tests => 51; +use Test::More tests => 55; my $fh; my $var = "aaa\n"; @@ -113,6 +113,47 @@ is(<$fh>, "shazam", "reading from magic scalars"); is($warn, 0, "no warnings when writing to an undefined scalar"); } +{ + use warnings; + my $warn = 0; + local $SIG{__WARN__} = sub { $warn++ }; + for (1..2) { + open my $fh, '>', \my $scalar; + close $fh; + } + is($warn, 0, "no warnings when reusing a lexical"); +} + +{ + use warnings; + my $warn = 0; + local $SIG{__WARN__} = sub { $warn++ }; + + my $fetch = 0; + { + package MgUndef; + sub TIESCALAR { bless [] } + sub FETCH { $fetch++; return undef } + } + tie my $scalar, MgUndef; + + open my $fh, '<', \$scalar; + close $fh; + is($warn, 0, "no warnings reading a magical undef scalar"); + is($fetch, 1, "FETCH only called once"); +} + +{ + use warnings; + my $warn = 0; + local $SIG{__WARN__} = sub { $warn++ }; + my $scalar = 3; + undef $scalar; + open my $fh, '<', \$scalar; + close $fh; + is($warn, 0, "no warnings reading an undef, allocated scalar"); +} + my $data = "a non-empty PV"; $data = undef; open(MEM, '<', \$data) or die "Fail: $!\n"; |