From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 31 Dec 2006 12:07:37 +0000 (+0000)
Subject: PL_linestr needs to survive until the end of scope, not just the next
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db4997f00d6b1ad267e4fec6a272e72e29719dd1;p=p5sagit%2Fp5-mst-13.2.git

PL_linestr needs to survive until the end of scope, not just the next
FREETMPS. Fixes the underlying cause of the thread cloning SEGV
reported in http://www.nntp.perl.org/group/perl.perl5.porters/63123

p4raw-id: //depot/perl@29643
---

diff --git a/MANIFEST b/MANIFEST
index 0921ac2..e3bd272 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3599,6 +3599,7 @@ t/op/switch.t			See if switches (given/when) work
 t/op/sysio.t			See if sysread and syswrite work
 t/op/taint.t			See if tainting works
 t/op/threads.t			Misc. tests for perl features with threads
+t/op/threads_create.pl		Ancillary file for t/op/threads.t
 t/op/tiearray.t			See if tie for arrays works
 t/op/tiehandle.t		See if tie for handles works
 t/op/tie.t			See if tie/untie functions work
diff --git a/sv.c b/sv.c
index 6303c4c..58c495e 100644
--- a/sv.c
+++ b/sv.c
@@ -11132,28 +11132,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_nexttoke		= proto_perl->Inexttoke;
 #endif
 
-    /* XXX This is probably masking the deeper issue of why
-     * SvANY(proto_perl->Ilinestr) can be NULL at this point. For test case:
-     * http://archive.develooper.com/perl5-porters%40perl.org/msg83298.html
-     * (A little debugging with a watchpoint on it may help.)
-     */
-    if (SvANY(proto_perl->Ilinestr)) {
-	PL_linestr		= sv_dup_inc(proto_perl->Ilinestr, param);
-	i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_bufptr		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_oldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
-	PL_oldoldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
-	PL_linestart	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    }
-    else {
-        PL_linestr = newSV(79);
-        sv_upgrade(PL_linestr,SVt_PVIV);
-        sv_setpvn(PL_linestr,"",0);
-	PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
-    }
+    PL_linestr		= sv_dup_inc(proto_perl->Ilinestr, param);
+    i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_bufptr		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_oldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
+    PL_oldoldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
+    PL_linestart	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
     PL_bufend		= SvPVX(PL_linestr) + SvCUR(PL_linestr);
     PL_pending_ident	= proto_perl->Ipending_ident;
     PL_sublex_info	= proto_perl->Isublex_info;	/* XXX not quite right */
@@ -11169,19 +11156,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_subline		= proto_perl->Isubline;
     PL_subname		= sv_dup_inc(proto_perl->Isubname, param);
 
-    /* XXX See comment on SvANY(proto_perl->Ilinestr) above */
-    if (SvANY(proto_perl->Ilinestr)) {
-	i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
-	PL_last_uni		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
-	PL_last_lop		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-	PL_last_lop_op	= proto_perl->Ilast_lop_op;
-    }
-    else {
-	PL_last_uni	= SvPVX(PL_linestr);
-	PL_last_lop	= SvPVX(PL_linestr);
-	PL_last_lop_op	= 0;
-    }
+    i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
+    PL_last_uni		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
+    PL_last_lop		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    PL_last_lop_op	= proto_perl->Ilast_lop_op;
     PL_in_my		= proto_perl->Iin_my;
     PL_in_my_stash	= hv_dup(proto_perl->Iin_my_stash, param);
 #ifdef FCRYPT
diff --git a/t/op/threads.t b/t/op/threads.t
index f699fc2..165c542 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -18,7 +18,7 @@ BEGIN {
        print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
        exit 0;
      }
-     plan(5);
+     plan(6);
 }
 use threads;
 
@@ -106,3 +106,10 @@ $SIG{__WARN__} = sub{};
 async sub {};
 print "ok";
 EOI
+
+# From a test case by Tim Bunce in
+# http://www.nntp.perl.org/group/perl.perl5.porters/63123
+fresh_perl_is(<<'EOI', 'ok', { }, 'Ensure PL_linestr can be cloned');
+use threads;
+print do 'op/threads_create.pl';
+EOI
diff --git a/t/op/threads_create.pl b/t/op/threads_create.pl
new file mode 100644
index 0000000..3425163
--- /dev/null
+++ b/t/op/threads_create.pl
@@ -0,0 +1,2 @@
+threads->create( sub { } )->join;
+"ok\n";
diff --git a/toke.c b/toke.c
index 89d8f0b..de98e41 100644
--- a/toke.c
+++ b/toke.c
@@ -668,6 +668,10 @@ Perl_lex_start(pTHX_ SV *line)
 	    sv_catpvs(PL_linestr, "\n;");
     }
     SvTEMP_off(PL_linestr);
+    /* PL_linestr needs to survive until end of scope, not just the next
+       FREETMPS. See changes 17505 and 17546 which fixed the symptoms only.  */
+    SvREFCNT_inc_simple_void_NN(PL_linestr);
+    SAVEFREESV(PL_linestr);
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
     PL_last_lop = PL_last_uni = NULL;