You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
76 lines
2.2 KiB
76 lines
2.2 KiB
7 years ago
|
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
|
||
|
|
|