From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 27 Oct 2013 12:52:09 +0000 (-0700)
Subject: Make PL_hintgv refcounted
X-Git-Tag: upstream/5.20.0~1442
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4639d557ab77c475c9938688efe6b61bedcecf8b;p=platform%2Fupstream%2Fperl.git

Make PL_hintgv refcounted

Otherwise one can free it (by deleting the *^H glob) and
cause a crash:

$ perl -e 'delete $::{"\cH"}; ${^OPEN}=foo'
Segmentation fault: 11

That happens because PL_hintgv points to a freed scalar, and
GvHV(PL_hintgv) ends up trying to access nonexistent fields.
---

diff --git a/perl.c b/perl.c
index 355d4dd..1361f58 100644
--- a/perl.c
+++ b/perl.c
@@ -3715,6 +3715,7 @@ S_init_main_stash(pTHX)
     SvREFCNT_inc_simple_void(PL_incgv); /* Don't allow it to be freed */
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */
+    SvREFCNT_inc_simple_void(PL_hintgv);
     GvMULTI_on(PL_hintgv);
     PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV);
     SvREFCNT_inc_simple_void(PL_defgv);
diff --git a/sv.c b/sv.c
index 441e781..45853f6 100644
--- a/sv.c
+++ b/sv.c
@@ -13567,7 +13567,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_envgv		= gv_dup_inc(proto_perl->Ienvgv, param);
     PL_incgv		= gv_dup(proto_perl->Iincgv, param);
-    PL_hintgv		= gv_dup(proto_perl->Ihintgv, param);
+    PL_hintgv		= gv_dup_inc(proto_perl->Ihintgv, param);
     PL_origfilename	= SAVEPV(proto_perl->Iorigfilename);
     PL_diehook		= sv_dup_inc(proto_perl->Idiehook, param);
     PL_warnhook		= sv_dup_inc(proto_perl->Iwarnhook, param);
diff --git a/t/op/magic.t b/t/op/magic.t
index 5b88947..bab7c94 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 => 186);
+    plan (tests => 187);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -652,6 +652,11 @@ eval '
 1' or die $@;
 is $stuff[0], $stuff[1], '$^H modifies ${^OPEN} consistently';
 
+# deleting $::{"\cH"}
+is runperl(prog => 'delete $::{qq-\cH-}; ${^OPEN}=foo; print qq-ok\n-'),
+  "ok\n",
+  'deleting $::{"\cH"}';
+
 # Tests for some non-magic names:
 is ${^MPE}, undef, '${^MPE} starts undefined';
 is ++${^MPE}, 1, '${^MPE} can be incremented';