Make PL_hintgv refcounted
authorFather Chrysostomos <sprout@cpan.org>
Sun, 27 Oct 2013 12:52:09 +0000 (05:52 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 28 Oct 2013 23:15:08 +0000 (16:15 -0700)
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.

perl.c
sv.c
t/op/magic.t

diff --git a/perl.c b/perl.c
index 355d4dd..1361f58 100644 (file)
--- 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 (file)
--- 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);
index 5b88947..bab7c94 100644 (file)
@@ -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';