|
 |
292b33 |
Ported to 5.16.1:
|
|
|
292b33 |
|
|
|
292b33 |
From 4505a31f43ca4e1a0e9203b389f6d4bebab9d899 Mon Sep 17 00:00:00 2001
|
|
|
292b33 |
From: Father Chrysostomos <sprout@cpan.org>
|
|
|
292b33 |
Date: Tue, 9 Oct 2012 20:47:18 -0700
|
|
|
292b33 |
Subject: [PATCH] =?UTF-8?q?[perl=20#115206]=20Don=E2=80=99t=20crash=20when=20?=
|
|
|
292b33 |
=?UTF-8?q?vivifying=20$|?=
|
|
|
292b33 |
MIME-Version: 1.0
|
|
|
292b33 |
Content-Type: text/plain; charset=UTF-8
|
|
|
292b33 |
Content-Transfer-Encoding: 8bit
|
|
|
292b33 |
|
|
|
292b33 |
It was trying to read the currently-selected handle without checking
|
|
|
292b33 |
whether it was selected. It is actually not necessary to initialise
|
|
|
292b33 |
the variable this way, as the next use of get-magic on it will clobber
|
|
|
292b33 |
the cached value.
|
|
|
292b33 |
|
|
|
292b33 |
This initialisation was originally added in commit d8ce0c9a45. The
|
|
|
292b33 |
bug it was fixing was probably caused by missing FETCH calls that are
|
|
|
292b33 |
no longer missing.
|
|
|
292b33 |
---
|
|
|
292b33 |
gv.c | 5 +----
|
|
|
292b33 |
t/op/magic.t | 5 ++++-
|
|
|
292b33 |
2 files changed, 5 insertions(+), 5 deletions(-)
|
|
|
292b33 |
|
|
|
292b33 |
diff --git a/gv.c b/gv.c
|
|
|
292b33 |
index f352452..cf02ca4 100644
|
|
|
292b33 |
--- a/gv.c
|
|
|
292b33 |
+++ b/gv.c
|
|
|
292b33 |
@@ -1913,10 +1913,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
|
|
|
292b33 |
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
|
|
|
292b33 |
"$%c is no longer supported", *name);
|
|
|
292b33 |
break;
|
|
|
292b33 |
- case '|': /* $| */
|
|
|
292b33 |
- sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
|
|
|
292b33 |
- goto magicalize;
|
|
|
292b33 |
-
|
|
|
292b33 |
case '\010': /* $^H */
|
|
|
292b33 |
{
|
|
|
292b33 |
HV *const hv = GvHVn(gv);
|
|
|
292b33 |
@@ -1957,6 +1953,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
|
|
|
292b33 |
case '>': /* $> */
|
|
|
292b33 |
case '\\': /* $\ */
|
|
|
292b33 |
case '/': /* $/ */
|
|
|
292b33 |
+ case '|': /* $| */
|
|
|
292b33 |
case '$': /* $$ */
|
|
|
292b33 |
case '\001': /* $^A */
|
|
|
292b33 |
case '\003': /* $^C */
|
|
|
292b33 |
diff --git a/t/op/magic.t b/t/op/magic.t
|
|
|
292b33 |
index 3fb1ea1..1bcfbd9 100644
|
|
|
292b33 |
--- a/t/op/magic.t
|
|
|
292b33 |
+++ b/t/op/magic.t
|
|
|
292b33 |
@@ -5,7 +5,7 @@ BEGIN {
|
|
|
292b33 |
chdir 't' if -d 't';
|
|
|
292b33 |
@INC = '../lib';
|
|
|
292b33 |
require './test.pl';
|
|
|
292b33 |
- plan (tests => 156);
|
|
|
292b33 |
+ plan (tests => 157);
|
|
|
292b33 |
}
|
|
|
292b33 |
|
|
|
292b33 |
# Test that defined() returns true for magic variables created on the fly,
|
|
|
292b33 |
@@ -581,6 +581,11 @@ SKIP: {
|
|
|
292b33 |
}
|
|
|
292b33 |
}
|
|
|
292b33 |
|
|
|
292b33 |
+# $|
|
|
|
292b33 |
+fresh_perl_is
|
|
|
292b33 |
+ 'select f; undef *f; ${q/|/}; print STDOUT qq|ok\n|', "ok\n", {},
|
|
|
292b33 |
+ '[perl #115206] no crash when vivifying $| while *{+select}{IO} is undef';
|
|
|
292b33 |
+
|
|
|
292b33 |
# ^^^^^^^^^ New tests go here ^^^^^^^^^
|
|
|
292b33 |
|
|
|
292b33 |
SKIP: {
|
|
|
292b33 |
--
|
|
|
292b33 |
1.7.7.6
|
|
|
292b33 |
|