Change 30096 by [EMAIL PROTECTED] on 2007/02/02 18:03:45
Integrate:
[ 28559]
Cleanup and conversion to t/test.pl
[ 29643]
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
[ 29668]
PVMG can be isUV too.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#300 integrate
... //depot/maint-5.8/perl/dump.c#76 edit
... //depot/maint-5.8/perl/ext/Devel/Peek/t/Peek.t#11 integrate
... //depot/maint-5.8/perl/sv.c#337 integrate
... //depot/maint-5.8/perl/t/op/threads.t#6 integrate
... //depot/maint-5.8/perl/t/op/threads_create.pl#1 branch
... //depot/maint-5.8/perl/toke.c#161 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#300 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#299~30068~ 2007-01-29 12:23:46.000000000 -0800
+++ perl/MANIFEST 2007-02-02 10:03:45.000000000 -0800
@@ -2873,6 +2873,7 @@
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
==== //depot/maint-5.8/perl/dump.c#76 (text) ====
Index: perl/dump.c
--- perl/dump.c#75~30077~ 2007-01-29 15:50:30.000000000 -0800
+++ perl/dump.c 2007-02-02 10:03:45.000000000 -0800
@@ -1249,6 +1249,7 @@
}
/* FALL THROUGH */
default:
+ evaled_or_uv:
if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
break;
@@ -1258,7 +1259,7 @@
break;
case SVt_PVMG:
if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
- break;
+ goto evaled_or_uv;
}
/* SVphv_SHAREKEYS is also 0x20000000 */
if ((type != SVt_PVHV) && SvUTF8(sv))
==== //depot/maint-5.8/perl/ext/Devel/Peek/t/Peek.t#11 (text) ====
Index: perl/ext/Devel/Peek/t/Peek.t
--- perl/ext/Devel/Peek/t/Peek.t#10~29901~ 2007-01-20 15:44:56.000000000
-0800
+++ perl/ext/Devel/Peek/t/Peek.t 2007-02-02 10:03:45.000000000 -0800
@@ -4,15 +4,17 @@
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- if ($Config{'extensions'} !~ /\bPeek\b/) {
+ if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) {
print "1..0 # Skip: Devel::Peek was not built\n";
exit 0;
}
}
+require "./test.pl";
+
use Devel::Peek;
-print "1..23\n";
+plan(24);
our $DEBUG = 0;
open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
@@ -33,9 +35,7 @@
print $pattern, "\n" if $DEBUG;
my $dump = <IN>;
print $dump, "\n" if $DEBUG;
- print "got:\n[\n$dump\n]\nexpected:\n[\n$pattern\n]\nnot "
- unless $dump =~ /\A$pattern\Z/ms;
- print "ok $_[0]\n";
+ like( $dump, qr/\A$pattern\Z/ms );
close(IN);
return $1;
} else {
@@ -51,6 +51,9 @@
my $c;
local $d = 0;
+END {
+ 1 while unlink("peek$$");
+}
do_test( 1,
$a = "foo",
'SV = PV\\($ADDR\\) at $ADDR
@@ -453,10 +456,6 @@
MG_VIRTUAL = &PL_vtbl_taint
MG_TYPE = PERL_MAGIC_taint\\(t\\)');
-END {
- 1 while unlink("peek$$");
-}
-
# blessed refs
do_test(22,
bless(\\undef, 'Foobar'),
@@ -515,3 +514,13 @@
OUTSIDE_SEQ = 0
PADLIST = 0x0
OUTSIDE = 0x0 \\(null\\)');
+
+# isUV should show on PVMG
+do_test(24,
+ do { my $v = $1; $v = ~0; $v },
+'SV = PVMG\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(IOK,pIOK,IsUV\\)
+ UV = \d+
+ NV = 0
+ PV = 0');
==== //depot/maint-5.8/perl/sv.c#337 (text) ====
Index: perl/sv.c
--- perl/sv.c#336~30077~ 2007-01-29 15:50:30.000000000 -0800
+++ perl/sv.c 2007-02-02 10:03:45.000000000 -0800
@@ -10683,28 +10683,15 @@
Copy(proto_perl->Inexttype, PL_nexttype, 5, I32);
PL_nexttoke = proto_perl->Inexttoke;
- /* 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
*/
@@ -10720,19 +10707,11 @@
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
==== //depot/maint-5.8/perl/t/op/threads.t#6 (text) ====
Index: perl/t/op/threads.t
--- perl/t/op/threads.t#5~29898~ 2007-01-20 10:43:49.000000000 -0800
+++ perl/t/op/threads.t 2007-02-02 10:03:45.000000000 -0800
@@ -18,7 +18,7 @@
print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
exit 0;
}
- plan(4);
+ plan(5);
}
use threads;
@@ -70,3 +70,10 @@
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
==== //depot/maint-5.8/perl/t/op/threads_create.pl#1 (text) ====
Index: perl/t/op/threads_create.pl
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/op/threads_create.pl 2007-02-02 10:03:45.000000000 -0800
@@ -0,0 +1,2 @@
+threads->create( sub { } )->join;
+"ok\n";
==== //depot/maint-5.8/perl/toke.c#161 (text) ====
Index: perl/toke.c
--- perl/toke.c#160~30075~ 2007-01-29 15:16:13.000000000 -0800
+++ perl/toke.c 2007-02-02 10:03:45.000000000 -0800
@@ -612,6 +612,10 @@
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;
End of Patch.
