From: Jerry D. Hedden Date: Mon, 27 Nov 2006 09:26:08 +0000 (-0800) Subject: [PATCH[ threads 1.53 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=894eec8b7139a2304cd70bab8bf666ee96a2b7e5;p=p5sagit%2Fp5-mst-13.2.git [PATCH[ threads 1.53 From: "Jerry D. Hedden" 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 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 5415914..65588b4 100755 --- 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);