From: David Mitchell <davem@iabyn.com>
Date: Sun, 28 Feb 2010 15:13:33 +0000 (+0000)
Subject: fix for [perl #72604] @DB::args and win32 fork
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a1f97a07fa8362ead50c8cd62c4ed6bb0066574f;p=p5sagit%2Fp5-mst-13.2.git

fix for [perl #72604] @DB::args and win32 fork

A previous fix for [perl #66108] (7fa38291524c327a3cb23bfe94979e1537743cac)
stopped cloning PL_dbargs, on the grounds that it was usually filled with
garbage (it contains an un-refcounted copy of @_'s elements; once the
function has returned, these may have been freed or reassigned). However,
the fix instead recreated PL_dbargs as a new empty AV that *wasn't* then
associated with the DB::args glob; so modifications to PL_dbargs weren't
seen via @DB::args.

The fix is to simply set it to null when cloning; pp_caller() will
recreate it again if necessary when it is needed.
---

diff --git a/sv.c b/sv.c
index 2f429cc..0e3c7be 100644
--- a/sv.c
+++ b/sv.c
@@ -12008,9 +12008,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     SvNV_set(&PL_sv_yes, 1);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
-    /* dbargs array probably holds garbage; give the child a clean array */
-    PL_dbargs		= newAV();
-    ptr_table_store(PL_ptr_table, proto_perl->Idbargs, PL_dbargs);
+    /* dbargs array probably holds garbage */
+    PL_dbargs		= NULL;
 
     /* create (a non-shared!) shared string table */
     PL_strtab		= newHV();
diff --git a/t/op/fork.t b/t/op/fork.t
index 9fe8107..fc9c58f 100644
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -462,3 +462,21 @@ sub { @_ = 3; fork ? die "1\n" : die "1\n" }->(2);
 EXPECT
 1
 1
+########
+# [perl #72604] @DB::args stops working across Win32 fork
+$|=1;
+sub f {
+    if ($pid = fork()) {
+	print "waitpid() returned ok\n" if waitpid($pid,0) == $pid;
+    }
+    else {
+	package DB;
+	my @c = caller(0);
+	print "child: called as [$c[3](", join(',',@DB::args), ")]\n";
+	exit(0);
+    }
+}
+f("foo", "bar");
+EXPECT
+child: called as [main::f(foo,bar)]
+waitpid() returned ok