From: Ben Morrow <ben@morrow.me.uk>
Date: Fri, 8 Feb 2008 13:50:09 +0000 (+0000)
Subject: Re: Unwanted warnings from "PerlIO::scalar"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=22ccb26d0b431d84f26a40d616613b1100362a43;p=p5sagit%2Fp5-mst-13.2.git

Re: Unwanted warnings from "PerlIO::scalar"
Message-ID: <20080208135008.GA3885@osiris.mauzo.dyndns.org>

p4raw-id: //depot/perl@33280
---

diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 2c8eacd..5828a55 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 81c9277..393ce0d 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";