[perl #115206] Don’t crash when vivifying $|
authorFather Chrysostomos <sprout@cpan.org>
Wed, 10 Oct 2012 03:47:18 +0000 (20:47 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 10 Oct 2012 13:08:23 +0000 (06:08 -0700)
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
t/op/magic.t

diff --git a/gv.c b/gv.c
index f352452..cf02ca4 100644 (file)
--- 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 */
index 3fb1ea1..1bcfbd9 100644 (file)
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 177);
+    plan (tests => 178);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -621,6 +621,9 @@ is ${^LAST_FH}, undef, '${^LAST_FH} is undef when PL_last_in_gv is NULL';
 # $|
 fresh_perl_is 'print $| = ~$|', "1\n", {switches => ['-l']}, 
  '[perl #4760] print $| = ~$|';
+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 ^^^^^^^^^