[PATCH[ threads 1.53

From: "Jerry D. Hedden" <jdhedden@yahoo.com>
Message-ID: <965653.3725.qm@web30206.mail.mud.yahoo.com>

p4raw-id: //depot/perl@29399

diff --git a/ext/threads/Changes b/ext/threads/Changes
index 22d8122..9e70741 100755 (executable)
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension threads.
 
+1.53 Mon Nov 27 12:08:27 EST 2006
+       - Fix for a thread cloning bug
+       - Fixes to test suite
+
 1.52 Tue Nov 21 11:04:03 EST 2006
        - Fix compiler warnings
 

diff --git a/ext/threads/README b/ext/threads/README
index 9399daf..9fa2903 100755 (executable)
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.52
+threads version 1.53
 ====================
 
 This module exposes interpreter threads to the Perl level.

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index b60f217..71ac219 100644 (file)
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -33,7 +33,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..32\n");   ### Number of tests that will be run ###
+    print("1..82\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -142,6 +142,7 @@ $Base++;
     $Base += 4;
 }
 
+
 # test cond_signal()
 {
     my $lock : shared;
@@ -192,7 +193,6 @@ $Base++;
     $tr->join();
 
     $Base += 5;
-
 }
 
 
@@ -259,7 +259,6 @@ $Base++;
     ok(2, $$r == 33, "cond_broadcast: ref: all three threads woken");
 
     $Base += 2;
-
 }
 
 
@@ -280,7 +279,42 @@ $Base++;
     cond_broadcast($lock);
     ok(4, $warncount == 2, 'get no warning on cond_broadcast');
 
-    #$Base += 4;
+    $Base += 4;
+}
+
+
+# Stress test
+{
+    my $cnt = 50;
+
+    my $mutex = 1;
+    share($mutex);
+
+    my @threads;
+    for (1..$cnt) {
+        my $thread = threads->create(sub {
+                        my $arg = $_;
+                        my $result = 0;
+                        for (0..1000000) {
+                            $result++;
+                        }
+                        lock($mutex);
+                        while ($mutex != $_) {
+                            cond_wait($mutex);
+                        }
+                        $mutex++;
+                        cond_broadcast($mutex);
+                        return $result;
+                      });
+        push(@threads, $thread);
+    }
+
+    for (1..$cnt) {
+        my $result = $threads[$_-1]->join();
+        ok($_, defined($result) && ("$result" eq '1000001'), "stress test - iter $_");
+    }
+
+    $Base += $cnt;
 }
 
 # EOF

diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 3e4b2c3..95a7610 100644 (file)
--- a/ext/threads/t/exit.t
+++ b/ext/threads/t/exit.t
@@ -56,7 +56,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.52;' .
+run_perl(prog => 'use threads 1.53;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -104,7 +104,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 1.52 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.53 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -112,7 +112,7 @@ run_perl(prog => 'use threads 1.52 qw(exit thread_only);' .
 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 
 
-my $out = run_perl(prog => 'use threads 1.52;' .
+my $out = run_perl(prog => 'use threads 1.53;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '})->join();' .
@@ -124,7 +124,7 @@ is($?>>8, 99, "exit(status) in thread");
 like($out, '1 finished and unjoined', "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 1.52 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.53 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -137,7 +137,7 @@ is($?>>8, 99, "set_thread_exit_only(0)");
 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 1.52;' .
+run_perl(prog => 'use threads 1.53;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .

diff --git a/ext/threads/t/libc.t b/ext/threads/t/libc.t
index 4935775..af6cc32 100644 (file)
--- a/ext/threads/t/libc.t
+++ b/ext/threads/t/libc.t
@@ -32,15 +32,6 @@ sub ok {
 use threads;
 
 BEGIN {
-    eval {
-        require threads::shared;
-        import threads::shared;
-    };
-    if ($@ || ! $threads::shared::threads_shared) {
-        print("1..0 # Skip: threads::shared not available\n");
-        exit(0);
-    }
-
     $| = 1;
     print("1..12\n");   ### Number of tests that will be run ###
 };
@@ -57,9 +48,6 @@ for (0..$i) {
     $localtime{$_} = localtime($_);
 };
 
-my $mutex = 2;
-share($mutex);
-
 my @threads;
 for (0..$i) {
     my $thread = threads->create(sub {
@@ -72,19 +60,14 @@ for (0..$i) {
                             $error++;
                         }
                     }
-                    lock($mutex);
-                    while ($mutex != ($_ + 2)) {
-                        cond_wait($mutex);
-                    }
-                    ok($mutex, ! $error, 'localtime safe');
-                    $mutex++;
-                    cond_broadcast($mutex);
+                    return $error;
                   });
     push @threads, $thread;
 }
 
-for (@threads) {
-    $_->join();
+for (0..$i) {
+    my $result = $threads[$_]->join();
+    ok($_ + 2, defined($result) && ("$result" eq '0'), 'localtime safe');
 }
 
 # EOF

diff --git a/ext/threads/t/stress_re.t b/ext/threads/t/stress_re.t
index 09d1fd2..6ba36ed 100644 (file)
--- a/ext/threads/t/stress_re.t
+++ b/ext/threads/t/stress_re.t
@@ -31,7 +31,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..63\n");   ### Number of tests that will be run ###
+    print("1..31\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -39,22 +39,23 @@ ok(1, 1, 'Loaded');
 
 ### Start of Testing ###
 
-sub test9 {
+my $cnt = 30;
+
+sub stress_re {
     my $s = "abcd" x (1000 + $_[0]);
     my $t = '';
     while ($s =~ /(.)/g) { $t .= $1 }
-    print "not ok $_[0]\n" if $s ne $t;
+    return ($s eq $t) ? 'ok' : 'not';
 }
+
 my @threads;
-for (2..32) {
-    ok($_, 1, "Multiple thread test");
-    push(@threads, threads->create('test9',$_));
+for (1..$cnt) {
+    push(@threads, threads->create('stress_re', $_));
 }
 
-my $i = 33;
-for (@threads) {
-    $_->join;
-    ok($i++, 1, "Thread joined");
+for (1..$cnt) {
+    my $result = $threads[$_-1]->join;
+    ok($_+1, defined($result) && ($result eq 'ok'), "stress re - iter $_");
 }
 
 # EOF

diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index 4c6c583..67882bd 100644 (file)
--- a/ext/threads/t/thread.t
+++ b/ext/threads/t/thread.t
@@ -171,7 +171,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.52;' .
+run_perl(prog => 'use threads 1.53;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,

diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index 702892e..ce74727 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.52';
+our $VERSION = '1.53';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -133,7 +133,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.52
+This document describes threads version 1.53
 
 =head1 SYNOPSIS
 
@@ -938,7 +938,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.52/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.53/threads.pm>
 
 L<threads::shared>, L<perlthrtut>
 

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 5415914..65588b4 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -569,7 +569,6 @@ S_ithread_create(
         SV       *params)
 {
     ithread     *thread;
-    CLONE_PARAMS clone_param;
     ithread     *current_thread = S_ithread_get(aTHX);
 
     SV         **tmps_tmp = PL_tmps_stack;
@@ -634,6 +633,8 @@ S_ithread_create(
      * context for the duration of our work for new interpreter.
      */
     {
+        CLONE_PARAMS clone_param;
+
         dTHXa(thread->interp);
 
         MY_CXT_CLONE;
@@ -644,7 +645,7 @@ S_ithread_create(
         SvREFCNT_dec(PL_endav);
         PL_endav = newAV();
 
-       clone_param.flags = 0;
+        clone_param.flags = 0;
         if (SvPOK(init_function)) {
             thread->init_function = newSV(0);
             sv_copypv(thread->init_function, init_function);