From: Jerry D. Hedden Date: Thu, 18 May 2006 13:22:20 +0000 (-0700) Subject: threads core dump in BEGIN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f2e0bb91ca7c0e6f975c2a54cb50ff00d953561c;p=p5sagit%2Fp5-mst-13.2.git threads core dump in BEGIN From: "Jerry D. Hedden" Message-Id: <20060518132220.fb30e530d17747c2b054d625b8945d88.f45de90925.wbe@email.secureserver.net> p4raw-id: //depot/perl@28229 --- diff --git a/MANIFEST b/MANIFEST index e90a084..6a80246 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1133,6 +1133,7 @@ ext/threads/shared/t/sv_simple.t thread shared variables ext/threads/shared/t/wait.t Test cond_wait and cond_timedwait ext/threads/shared/typemap thread::shared types ext/threads/t/basic.t ithreads +ext/threads/t/blocks.t Test threads in special blocks ext/threads/t/end.t Test end functions ext/threads/t/free.t Test ithread destruction ext/threads/t/free2.t More ithread destruction tests diff --git a/ext/threads/Changes b/ext/threads/Changes index 025f6f7..0835079 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension threads. +1.29 Thu May 18 16:09:28 EDT 2006 + - Fix warning/core dump from ->create('foo') in BEGIN block + 1.28 Wed May 17 14:33:13 EDT 2006 - Fix for build failure under older Perl versions - Skip signalling tests if using unsafe signals diff --git a/ext/threads/README b/ext/threads/README index c622060..6e33bdc 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.28 +threads version 1.29 ==================== This module needs perl 5.8.0 or later compiled with 'useithreads'. diff --git a/ext/threads/t/blocks.t b/ext/threads/t/blocks.t new file mode 100644 index 0000000..a4917b0 --- /dev/null +++ b/ext/threads/t/blocks.t @@ -0,0 +1,91 @@ +use strict; +use warnings; + +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; + if (! $Config{'useithreads'}) { + print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); + exit(0); + } +} + +use ExtUtils::testlib; + +use threads; +use threads::shared; + +my $TEST; +BEGIN { + $| = 1; + print("1..5\n"); ### Number of tests that will be run ### + + share($TEST); + $TEST = 1; +}; + +ok(1, 'Loaded'); + +sub ok { + my ($ok, $name) = @_; + + lock($TEST); + my $id = $TEST++; + + # You have to do it this way or VMS will get confused. + if ($ok) { + print("ok $id - $name\n"); + } else { + print("not ok $id - $name\n"); + printf("# Failed test at line %d\n", (caller)[2]); + } + + return ($ok); +} + + +### Start of Testing ### + +$SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); }; + +sub foo { } +sub baz { 42 } + +my $bthr; +BEGIN { + $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); }; + + threads->create('foo')->join(); + threads->create(\&foo)->join(); + threads->create(sub {})->join(); + + threads->create('foo')->detach(); + threads->create(\&foo)->detach(); + threads->create(sub {})->detach(); + + $bthr = threads->create('baz'); +} + +my $mthr; +MAIN: { + threads->create('foo')->join(); + threads->create(\&foo)->join(); + threads->create(sub {})->join(); + + threads->create('foo')->detach(); + threads->create(\&foo)->detach(); + threads->create(sub {})->detach(); + + $mthr = threads->create('baz'); +} + +ok($mthr, 'Main thread'); +ok($bthr, 'BEGIN thread'); + +ok($mthr->join() == 42, 'Main join'); +ok($bthr->join() == 42, 'BEGIN join'); + +# EOF diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 789d16f..39416d3 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '1.28'; +our $VERSION = '1.29'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -102,7 +102,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.28 +This document describes threads version 1.29 =head1 SYNOPSIS @@ -587,11 +587,10 @@ there are still existing I threads. =item Creating threads inside special blocks -Creating threads inside C, C or C blocks cannot be relied -upon. Depending on the Perl version and the application code, results may -range from success, to (apparently harmless) warnings of leaked scalar or -attempts to free unreferenced scalars, all the way up to crashing of the Perl -interpreter. +Creating threads inside C, C or C blocks should not be +relied upon. Depending on the Perl version and the application code, results +may range from success, to (apparently harmless) warnings of leaked scalar, +all the way up to crashing of the Perl interpreter. =item Unsafe signals @@ -618,8 +617,8 @@ the C<-Ekill()> signalling method cannot be used. =item Returning closures from threads -Returning closures from threads cannot be relied upon. Depending of the Perl -version and the application code, results may range from success, to +Returning closures from threads should not be relied upon. Depending of the +Perl version and the application code, results may range from success, to (apparently harmless) warnings of leaked scalar, all the way up to crashing of the Perl interpreter. @@ -647,7 +646,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 307554d..4d9ef4c 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -522,10 +522,15 @@ S_ithread_create( SvREFCNT_dec(PL_endav); PL_endav = newAV(); - clone_param.flags = 0; - thread->init_function = sv_dup(init_function, &clone_param); - if (SvREFCNT(thread->init_function) == 0) { - SvREFCNT_inc(thread->init_function); + if (SvPOK(init_function)) { + thread->init_function = newSV(0); + sv_copypv(thread->init_function, init_function); + } else { + clone_param.flags = 0; + thread->init_function = sv_dup(init_function, &clone_param); + if (SvREFCNT(thread->init_function) == 0) { + SvREFCNT_inc(thread->init_function); + } } thread->params = sv_dup(params, &clone_param);