From db4997f00d6b1ad267e4fec6a272e72e29719dd1 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 31 Dec 2006 12:07:37 +0000 Subject: [PATCH] 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 --- MANIFEST | 1 + sv.c | 49 ++++++++++++++----------------------------------- t/op/threads.t | 9 ++++++++- t/op/threads_create.pl | 2 ++ toke.c | 4 ++++ 5 files changed, 29 insertions(+), 36 deletions(-) create mode 100644 t/op/threads_create.pl 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; -- 1.8.3.1