From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 27 Oct 2013 21:37:10 +0000 (-0700)
Subject: Make PL_argvgv refcounted
X-Git-Tag: upstream/5.20.0~1439
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=722fa0e9973574787e686d761e198d8854b28688;p=platform%2Fupstream%2Fperl.git

Make PL_argvgv refcounted

Otherwise one can free it and cause assertion failures when other
things do SvREFCNT_inc on a freed scalar:

$ ./miniperl -le 'undef *x; delete $::{ARGV}; $x++; eval "BEGIN{undef *x} readline"'
Assertion failed: (SvTYPE(sv) != (svtype)SVTYPEMASK), function Perl_sv_clear, file sv.c, line 6215.
Abort trap: 6
---

diff --git a/perl.c b/perl.c
index 1361f58..011b0a2 100644
--- a/perl.c
+++ b/perl.c
@@ -952,7 +952,6 @@ perl_destruct(pTHXx)
     PL_incgv = NULL;
     PL_hintgv = NULL;
     PL_errgv = NULL;
-    PL_argvgv = NULL;
     PL_argvoutgv = NULL;
     PL_stdingv = NULL;
     PL_stderrgv = NULL;
@@ -966,10 +965,12 @@ perl_destruct(pTHXx)
     PL_debstash = NULL;
 
     SvREFCNT_dec(PL_envgv);
+    SvREFCNT_dec(PL_argvgv);
     SvREFCNT_dec(PL_DBgv);
     SvREFCNT_dec(PL_DBline);
     SvREFCNT_dec(PL_DBsub);
     PL_envgv = NULL;
+    PL_argvgv = NULL;
     PL_DBgv = NULL;
     PL_DBline = NULL;
     PL_DBsub = NULL;
@@ -4261,6 +4262,7 @@ Perl_init_argv_symbols(pTHX_ int argc, char **argv)
 	}
     }
     if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD|GV_NOTQUAL, SVt_PVAV))) {
+	SvREFCNT_inc_simple_void_NN(PL_argvgv);
 	GvMULTI_on(PL_argvgv);
 	av_clear(GvAVn(PL_argvgv));
 	for (; argc > 0; argc--,argv++) {
diff --git a/sv.c b/sv.c
index f649ad9..f17508b 100644
--- a/sv.c
+++ b/sv.c
@@ -13609,7 +13609,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_stdingv		= gv_dup(proto_perl->Istdingv, param);
     PL_stderrgv		= gv_dup(proto_perl->Istderrgv, param);
     PL_defgv		= gv_dup(proto_perl->Idefgv, param);
-    PL_argvgv		= gv_dup(proto_perl->Iargvgv, param);
+    PL_argvgv		= gv_dup_inc(proto_perl->Iargvgv, param);
     PL_argvoutgv	= gv_dup(proto_perl->Iargvoutgv, param);
     PL_argvout_stack	= av_dup_inc(proto_perl->Iargvout_stack, param);
 
diff --git a/t/io/argv.t b/t/io/argv.t
index 95e962d..a1febaf 100644
--- a/t/io/argv.t
+++ b/t/io/argv.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan(tests => 23);
+plan(tests => 24);
 
 my ($devnull, $no_devnull);
 
@@ -147,6 +147,16 @@ close IN;
 unlink "Io_argv3.tmp";
 **PROG**
 
+# This used to fail an assertion.
+# The tricks with *x and $x are to make PL_argvgv point to a freed SV when
+# the readline op does SvREFCNT_inc on it.  undef *x clears the scalar slot
+# ++$x vivifies it, reusing the just-deleted GV that PL_argvgv still points
+# to.  The BEGIN block ensures it is freed late enough that nothing else
+# has reused it yet.
+is runperl(prog => 'undef *x; delete $::{ARGV}; $x++;'
+                  .'eval q-BEGIN{undef *x} readline-; print qq-ok\n-'),
+  "ok\n", 'deleting $::{ARGV}';
+
 END {
     unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
 	'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';