Blob Blame History Raw
Ported to 5.16.1:

From 4505a31f43ca4e1a0e9203b389f6d4bebab9d899 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 9 Oct 2012 20:47:18 -0700
Subject: [PATCH] =?UTF-8?q?[perl=20#115206]=20Don=E2=80=99t=20crash=20when=20?=
 =?UTF-8?q?vivifying=20$|?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

It was trying to read the currently-selected handle without checking
whether it was selected.  It is actually not necessary to initialise
the variable this way, as the next use of get-magic on it will clobber
the cached value.

This initialisation was originally added in commit d8ce0c9a45.  The
bug it was fixing was probably caused by missing FETCH calls that are
no longer missing.
---
 gv.c         |    5 +----
 t/op/magic.t |    5 ++++-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/gv.c b/gv.c
index f352452..cf02ca4 100644
--- a/gv.c
+++ b/gv.c
@@ -1913,10 +1913,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 				 "$%c is no longer supported", *name);
 	    break;
-	case '|':		/* $| */
-	    sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
-	    goto magicalize;
-
 	case '\010':	/* $^H */
 	    {
 		HV *const hv = GvHVn(gv);
@@ -1957,6 +1953,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	case '>':		/* $> */
 	case '\\':		/* $\ */
 	case '/':		/* $/ */
+	case '|':		/* $| */
 	case '$':		/* $$ */
 	case '\001':	/* $^A */
 	case '\003':	/* $^C */
diff --git a/t/op/magic.t b/t/op/magic.t
index 3fb1ea1..1bcfbd9 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 156);
+    plan (tests => 157);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -581,6 +581,11 @@ SKIP: {
     }
 }
 
+# $|
+fresh_perl_is
+ 'select f; undef *f; ${q/|/}; print STDOUT qq|ok\n|', "ok\n", {}, 
+ '[perl #115206] no crash when vivifying $| while *{+select}{IO} is undef';
+
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {
-- 
1.7.7.6