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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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;