threads core dump in BEGIN

From:  "Jerry D. Hedden" <jerry@hedden.us>
Message-Id:  <20060518132220.fb30e530d17747c2b054d625b8945d88.f45de90925.wbe@email.secureserver.net>

p4raw-id: //depot/perl@28229

diff --git a/MANIFEST b/MANIFEST
index e90a084..6a80246 100644 (file)
--- 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 (executable)
--- 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 (executable)
--- 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 (file)
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 (executable)
--- 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<child> threads.
 
 =item Creating threads inside special blocks
 
-Creating threads inside C<BEGIN>, C<CHECK> or C<INIT> 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<BEGIN>, C<CHECK> or C<INIT> 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<-E<gt>kill()> 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<threads> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads>
 
 Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.28/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.29/shared.pm>
 
 L<threads::shared>, L<perlthrtut>
 

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 307554d..4d9ef4c 100755 (executable)
--- 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);