From: Jerry D. Hedden Date: Thu, 23 Mar 2006 09:19:54 +0000 (-0700) Subject: (2nd revised) 1st patch to sync blead 'threads' with CPAN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f1612a7416fa2b6a078554fb1e7168e5fd5c31c;p=p5sagit%2Fp5-mst-13.2.git (2nd revised) 1st patch to sync blead 'threads' with CPAN From: "Jerry D. Hedden" Message-ID: <20060323091954.fb30e530d17747c2b054d625b8945d88.884826707f.wbe@email.email.secureserver.net> p4raw-id: //depot/perl@27594 --- diff --git a/ext/threads/Changes b/ext/threads/Changes index d832435..cda33b2 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,42 @@ Revision history for Perl extension threads. +1.17 Thu Mar 23 10:31:20 EST 2006 + - Restoration of 'core' build parameters + +1.15 Wed Mar 22 13:46:51 EST 2006 + - BUG FIX: Replaced SvPV_nolen_const macro + - Disabled closure return test again and added note in POD + +1.14 Tue Mar 21 08:40:16 EST 2006 + - BUG FIX: Corrected UV formatting string + +1.13 Mon Mar 20 15:09:42 EST 2006 + - BUG FIX: Round stack sizes to multiple of page size + - Use PTHREAD_STACK_MIN if available + +1.12 Sun Mar 19 17:34:49 EST 2006 + - Implemented $thr1->equal($thr2) in XS + - Use $ENV{PERL_CORE} in tests + +1.11 Fri Mar 17 13:24:35 EST 2006 + - BUG FIX: Proper freeing thread's Perl interpreter + - Removed BUGS POD item regarding returning objects from threads + - Enabled closure return test in t/problems.t + - Handle deprecation of :unique in tests + - XS code cleanup + - Better POD coverage + +1.09 Mon Mar 13 14:14:37 EST 2006 + - Initial (re-)release to CPAN + - 64-bit TIDs + - API for thread stack size (courtesy of Dean Arnold) + - Made threads->list() context sensitive + - Implemented threads->object($tid) in XS + - Added $thr->_handle() method + + +Ancient history: + 0.03 Mon Jul 2 12:00:50 CEST 2001 Fixed bug with threads->self() in main thread, thanks Hackworth! diff --git a/ext/threads/Makefile.PL b/ext/threads/Makefile.PL index e7d2d66..349cb4b 100755 --- a/ext/threads/Makefile.PL +++ b/ext/threads/Makefile.PL @@ -1,28 +1,60 @@ +# Module makefile for threads (using ExtUtils::MakeMaker) + +require 5.008; + +use strict; +use warnings; + use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. + + +# Build options for different environments +my @conditional_params; +if (grep { $_ eq 'PERL_CORE=1' } @ARGV) { + # Core + push(@conditional_params, 'MAN3PODS' => {}, + 'NORECURS' => 1); +} else { + # CPAN + push(@conditional_params, 'CCFLAGS' => '-DHAS_PPPORT_H'); +} + WriteMakefile( - 'NAME' => 'threads', - 'VERSION_FROM' => 'threads.pm', # finds $VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 - ($] >= 5.005 ? ## Add these new keywords supported since 5.005 - (ABSTRACT_FROM => 'threads.pm', # retrieve abstract from module - AUTHOR => 'Artur Bergman ') : ()), - 'MAN3PODS' => {}, # Pods will be built by installman - 'LIBS' => [''], # e.g., '-lm' - 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' - # Insert -I. if you add *.h files later: -# 'INC' => '', # e.g., '-I/usr/include/other' - # Un-comment this if you add C files to link with later: - # 'OBJECT' => '$(O_FILES)', # link all the C files too - - # ext/threads/shared is a completely different module. Don't - # recurse into it. - 'NORECURS' => 1, - - # Bug in MakeMaker continues to put ext/threads/shared into DIR - # even if we said NORECURS. Remove when fixed. - 'DIR' => [], + 'NAME' => 'threads', + 'AUTHOR' => 'Artur Bergman ', + 'VERSION_FROM' => 'threads.pm', + 'ABSTRACT_FROM' => 'threads.pm', + 'PM' => { + 'threads.pm' => '$(INST_LIBDIR)/threads.pm', + }, + 'PREREQ_PM' => { + 'threads::shared' => 0, + 'XSLoader' => 0, + }, + 'INSTALLDIRS' => 'perl', + + ((ExtUtils::MakeMaker->VERSION() lt '6.25') ? + ('PL_FILES' => { }) : ()), + ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? + ('LICENSE' => 'perl') : ()), + + @conditional_params ); + +# Add additional target(s) to Makefile for use by module maintainer +sub MY::postamble +{ + return <<'_EXTRAS_'; +ppport: + @( cd /tmp; perl -e 'use Devel::PPPort; Devel::PPPort::WriteFile("ppport.h");' ) + @if ! cmp -s ppport.h /tmp/ppport.h; then \ + diff ppport.h /tmp/ppport.h ; \ + echo; \ + perl /tmp/ppport.h; \ + fi +_EXTRAS_ +} + +# EOF diff --git a/ext/threads/README b/ext/threads/README index dd3f8fe..ce7d554 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,8 +1,8 @@ -threads version 0.03 +threads version 1.17 ==================== -This module needs perl 5.7.2 or later compiled with USEITHREADS, -it exposes interpreter threads to the perl level. +This module needs perl 5.8.0 or later compiled with 'useithreads'. +It exposes interpreter threads to the Perl level. INSTALLATION @@ -17,8 +17,13 @@ DEPENDENCIES This module requires these other modules and libraries: + threads::shared COPYRIGHT AND LICENCE -Copyright (C) 2001 Artur Bergman artur at contiller.se -Same licence as perl. +Copyright (C) 2001 Artur Bergman +Same licence as Perl. + +CPAN version produced by Jerry D. Hedden + +# EOF diff --git a/ext/threads/t/basic.t b/ext/threads/t/basic.t index 09a148d..a4c4fef 100755 --- a/ext/threads/t/basic.t +++ b/ext/threads/t/basic.t @@ -1,4 +1,5 @@ - +use strict; +use warnings; # # The reason this does not use a Test module is that @@ -14,9 +15,11 @@ BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -24,17 +27,19 @@ BEGIN { } use ExtUtils::testlib; -use strict; -BEGIN { $| = 1; print "1..19\n" }; -use threads; +BEGIN { $| = 1; print "1..28\n" }; +use threads; -print "ok 1\n"; +if ($threads::VERSION && ! exists($ENV{'PERL_CORE'})) { + print(STDERR "# Testing threads $threads::VERSION\n"); +} -######################### +ok(1, 1, 'Loaded'); +### Start of Testing ### @@ -50,7 +55,6 @@ sub ok { } - sub test1 { ok(2,'bar' eq $_[0],"Test that argument passing works"); } @@ -60,12 +64,12 @@ sub test2 { ok(3,'bar' eq $_[0]->[0]->{foo},"Test that passing arguments as references work"); } -threads->create('test2',[{foo => 'bar'}])->join(); +threads->create(\&test2,[{foo => 'bar'}])->join(); #test execuion of normal sub sub test3 { ok(4,shift() == 1,"Test a normal sub") } -threads->create('test3',1)->join(); +threads->create(\&test3,1)->join(); #check Config @@ -134,11 +138,31 @@ ok(15, 0 == threads->tid(),"Check so that tid for threads work for main thread") })->join(); } -1; +my $thr1 = threads->create(sub {}); +my $thr2 = threads->create(sub {}); +my $thr3 = threads->object($thr1->tid()); + +ok(20, $thr1 != $thr2, 'Treads not equal'); +ok(21, $thr1 == $thr3, 'Threads equal'); +ok(22, threads->object($thr1->tid())->tid() == 11, 'Object method'); +ok(23, threads->object($thr2->tid())->tid() == 12, 'Object method'); +$thr1->join(); +$thr2->join(); +my $sub = sub { ok(24, shift() == 1, "Test code ref"); }; +threads->create($sub, 1)->join(); +my $thrx = threads->object(99); +ok(25, ! defined($thrx), 'No object'); +$thrx = threads->object(); +ok(26, ! defined($thrx), 'No object'); +$thrx = threads->object(undef); +ok(27, ! defined($thrx), 'No object'); +$thrx = threads->object(0); +ok(28, ! defined($thrx), 'No object'); +# EOF diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t index 351a989..8f84eed 100644 --- a/ext/threads/t/end.t +++ b/ext/threads/t/end.t @@ -1,30 +1,29 @@ +use strict; +use warnings; # test that END blocks are run in the thread that created them and # not in any child threads BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; } - if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) { - print "1..0 # Skip: Devel::Peek was not built\n"; - exit 0; - } } use ExtUtils::testlib; -use strict; + BEGIN { print "1..6\n" }; use threads; use threads::shared; my $test_id = 1; share($test_id); -use Devel::Peek qw(Dump); sub ok { my ($ok, $name) = @_; @@ -36,7 +35,7 @@ sub ok { $test_id++; return $ok; } -ok(1,''); +ok(1,'Loaded'); END { ok(1,"End block run once") } threads->create(sub { eval "END { ok(1,'') }"})->join(); threads->create(sub { eval "END { ok(1,'') }"})->join(); diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t index dbd6448..a395f78 100644 --- a/ext/threads/t/join.t +++ b/ext/threads/t/join.t @@ -1,19 +1,20 @@ +use strict; +use warnings; + BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; } - if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) { - print "1..0 # Skip: Devel::Peek was not built\n"; - exit 0; - } } use ExtUtils::testlib; -use strict; + BEGIN { print "1..14\n" }; use threads; use threads::shared; diff --git a/ext/threads/t/libc.t b/ext/threads/t/libc.t index f0567ba..51bc5d6 100644 --- a/ext/threads/t/libc.t +++ b/ext/threads/t/libc.t @@ -1,8 +1,12 @@ +use strict; +use warnings; BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -10,7 +14,7 @@ BEGIN { } use ExtUtils::testlib; -use strict; + BEGIN { $| = 1; print "1..11\n"}; use threads; diff --git a/ext/threads/t/list.t b/ext/threads/t/list.t index f8f82d2..0e3c5b2 100644 --- a/ext/threads/t/list.t +++ b/ext/threads/t/list.t @@ -1,8 +1,12 @@ +use strict; +use warnings; BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -11,7 +15,6 @@ BEGIN { use ExtUtils::testlib; -use strict; BEGIN { $| = 1; print "1..8\n" }; diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t index 9a955ab..d832124 100644 --- a/ext/threads/t/problems.t +++ b/ext/threads/t/problems.t @@ -1,28 +1,44 @@ +use strict; +use warnings; BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; } } -use warnings; -no warnings 'deprecated'; -use strict; +use ExtUtils::testlib; + +BEGIN { + $| = 1; + if ($] == 5.008) { + print("1..14\n"); ### Number of tests that will be run ### + } else { + print("1..15\n"); ### Number of tests that will be run ### + } +}; + use threads; use threads::shared; +print("ok 1 - Loaded\n"); + +### Start of Testing ### + +no warnings 'deprecated'; # Suppress warnings related to :unique + use Hash::Util 'lock_keys'; # Note that we can't use Test::More here, as we would need to # call is() from within the DESTROY() function at global destruction time, # and parts of Test::* may have already been freed by then -print "1..14\n"; - -my $test : shared = 1; +my $test : shared = 2; sub is($$$) { my ($got, $want, $desc) = @_; @@ -43,8 +59,6 @@ sub is($$$) { # ######################### -$|++; - { sub Foo::DESTROY { my $self = shift; @@ -70,9 +84,13 @@ $|++; # ######################### -threads->new( sub {1} )->join; -my $not = eval { Config::myconfig() } ? '' : 'not '; -print "${not}ok $test - Are we able to call Config::myconfig after clone\n"; +if ($] == 5.008 || $] >= 5.008003) { + threads->new( sub {1} )->join; + my $not = eval { Config::myconfig() } ? '' : 'not '; + print "${not}ok $test - Are we able to call Config::myconfig after clone\n"; +} else { + print "ok $test # Skip Are we able to call Config::myconfig after clone\n"; +} $test++; # bugid 24383 - :unique hashes weren't being made readonly on interpreter @@ -92,9 +110,13 @@ threads->new( print $@ =~ /read-only/ ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n"; $test++; - eval { $unique_hash{abc} = 1 }; - print $@ =~ /disallowed/ - ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n"; + if ($] >= 5.008003 && $^O ne 'MSWin32') { + eval { $unique_hash{abc} = 1 }; + print $@ =~ /disallowed/ + ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n"; + } else { + print("ok $test # Skip $TODO - unique_hash\n"); + } $test++; } )->join; @@ -102,10 +124,13 @@ threads->new( # bugid #24940 :unique should fail on my and sub declarations for my $decl ('my $x : unique', 'sub foo : unique') { - eval $decl; - print $@ =~ - /^The 'unique' attribute may only be applied to 'our' variables/ - ? '' : 'not ', "ok $test - $decl\n"; + if ($] >= 5.008005) { + eval $decl; + print $@ =~ /^The 'unique' attribute may only be applied to 'our' variables/ + ? '' : 'not ', "ok $test - $decl\n"; + } else { + print("ok $test # Skip $decl\n"); + } $test++; } @@ -126,6 +151,7 @@ for my $decl ('my $x : unique', 'sub foo : unique') { # print $string eq 'foobar' ? '' : 'not ', "ok $test - returning closure\n"; # $test++; + # Nothing is checking that total keys gets cloned correctly. my %h = (1,2,3,4); diff --git a/ext/threads/t/stress_cv.t b/ext/threads/t/stress_cv.t index 407a7fd..95686c1 100644 --- a/ext/threads/t/stress_cv.t +++ b/ext/threads/t/stress_cv.t @@ -1,7 +1,12 @@ +use strict; +use warnings; + BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -9,7 +14,7 @@ BEGIN { } use ExtUtils::testlib; -use strict; + BEGIN { print "1..64\n" }; use threads; diff --git a/ext/threads/t/stress_re.t b/ext/threads/t/stress_re.t index aa89b19..5f8d910 100644 --- a/ext/threads/t/stress_re.t +++ b/ext/threads/t/stress_re.t @@ -1,7 +1,12 @@ +use strict; +use warnings; + BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -9,7 +14,7 @@ BEGIN { } use ExtUtils::testlib; -use strict; + BEGIN { print "1..64\n" }; use threads; diff --git a/ext/threads/t/stress_string.t b/ext/threads/t/stress_string.t index 3cd1e8e..4055b66 100644 --- a/ext/threads/t/stress_string.t +++ b/ext/threads/t/stress_string.t @@ -1,7 +1,12 @@ +use strict; +use warnings; + BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; @@ -9,7 +14,7 @@ BEGIN { } use ExtUtils::testlib; -use strict; + BEGIN { print "1..64\n" }; use threads; diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index de1e938..befc4a4 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -1,17 +1,22 @@ +use strict; +use warnings; BEGIN { - chdir 't' if -d 't'; - push @INC, '../lib','.'; - require Config; import Config; + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; unless ($Config{'useithreads'}) { print "1..0 # Skip: no useithreads\n"; exit 0; } - require "test.pl"; + + require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); } use ExtUtils::testlib; -use strict; + BEGIN { $| = 1; print "1..31\n" }; use threads; use threads::shared; @@ -160,8 +165,7 @@ run_perl(prog => is($?, 0, 'coredump in global destruction'); # test CLONE_SKIP() functionality - -{ +if ($] >= 5.008007) { my %c : shared; my %d : shared; @@ -268,5 +272,13 @@ is($?, 0, 'coredump in global destruction'); ) }), "counts of calls to DESTROY"); + +} else { + print("ok 27 # Skip objs clone skip at depth 0\n"); + print("ok 28 # Skip objs clone skip at depth 1\n"); + print("ok 29 # Skip objs clone skip at depth 2\n"); + print("ok 30 # Skip counts of calls to CLONE_SKIP\n"); + print("ok 31 # Skip counts of calls to DESTROY\n"); } +# EOF diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 91747e7..fdd9c01 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -38,20 +38,43 @@ BEGIN { if($threads::shared::threads_shared); } -require Exporter; -require DynaLoader; +our $VERSION = '1.17'; -our @ISA = qw(Exporter DynaLoader); -our %EXPORT_TAGS = ( all => [qw(yield)]); +# Load the XS code +require XSLoader; +XSLoader::load('threads', $VERSION); -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); -our @EXPORT = qw( -async -); -our $VERSION = '1.07_01'; +### Export ### +sub import +{ + my $class = shift; # Not used + + # Exported subroutines + my @EXPORT = qw(async); + + # Handle args + while (my $sym = shift) { + if ($sym =~ /all/) { + push(@EXPORT, qw(yield)); + + } else { + push(@EXPORT, $sym); + } + } + + # Export subroutine names + my $caller = caller(); + foreach my $sym (@EXPORT) { + no strict 'refs'; + *{$caller.'::'.$sym} = \&{$sym}; + } +} + + +### Methods, etc. ### # || 0 to ensure compatibility with previous versions sub equal { ($_[0]->tid == $_[1]->tid) || 0 } @@ -70,45 +93,58 @@ sub object { $threads::threads = 1; -bootstrap threads $VERSION; - # why document 'new' then use 'create' in the tests! *create = \&new; -# Preloaded methods go here. - 1; + __END__ =head1 NAME -threads - Perl extension allowing use of interpreter based threads from perl +threads - Perl interpreter-based threads + +=head1 VERSION + +This document describes threads version 1.17 =head1 SYNOPSIS - use threads; + use threads ('yield'); sub start_thread { - print "Thread started\n"; + my @args = @_; + print "Thread started: @args\n"; } + my $thread = threads->create('start_thread', 'argument'); + $thread->join(); + + threads->create(sub { print("I am a thread\n"); })->join(); - my $thread = threads->create("start_thread","argument"); - my $thread2 = $thread->create(sub { print "I am a thread"},"argument"); my $thread3 = async { foreach (@files) { ... } }; + $thread3->join(); + + # Invoke thread in list context so it can return a list + my ($thr) = threads->create(sub { return (qw/a b c/); }); + my @results = $thr->join(); - $thread->join(); $thread->detach(); $thread = threads->self(); - $thread = threads->object( $tid ); + $thread = threads->object($tid); - $thread->tid(); - threads->tid(); - threads->self->tid(); + $tid = threads->tid(); + $tid = threads->self->tid(); + $tid = $thread->tid(); threads->yield(); + yield(); + + my @threads = threads->list(); - threads->list(); + if ($thr1 == $thr2) { + ... + } =head1 DESCRIPTION @@ -135,55 +171,101 @@ it the other way around. =over -=item $thread = threads->create(function, LIST) +=item $thr = threads->create(FUNCTION, ARGS) -This will create a new thread with the entry point function and give -it LIST as parameters. It will return the corresponding threads -object, or C if thread creation failed. The new() method is an -alias for create(). +This will create a new thread that will begin execution with the specified +entry point function, and give it the I list as parameters. It will +return the corresponding threads object, or C if thread creation failed. -=item $thread->join +I may either be the name of a function, an anonymous subroutine, or +a code ref. -This will wait for the corresponding thread to join. When the thread -finishes, join() will return the return values of the entry point -function. If the thread has been detached, an error will be thrown. + my $thr = threads->create('func_name', ...); + # or + my $thr = threads->create(sub { ... }, ...); + # or + my $thr = threads->create(\&func, ...); -The context (void, scalar or list) of the thread creation is also the -context for join(). This means that if you intend to return an array -from a thread, you must use Cnew(...)>, and -that if you intend to return a scalar, you must use C. +The thread may be created in I context, or I context as follows: + + # Create thread in list context + my ($thr) = threads->create(...); + + # Create thread in scalar context + my $thr = threads->create(...); + +This has consequences for the C<-Ejoin()> method describe below. + +Although a thread may be created in I context, to do so you must +I either the C<-Ejoin()> or C<-Edetach()> method to the +C<-Ecreate()> call: -If the program exits without all other threads having been either -joined or detached, then a warning will be issued. (A program exits -either because one of its threads explicitly calls exit(), or in the -case of the main thread, reaches the end of the main program file.) + threads->create(...)->join(); +The C<-Enew()> method is an alias for C<-Ecreate()>. + +=item $thr->join() + +This will wait for the corresponding thread to complete its execution. When +the thread finishes, C<-Ejoin()> will return the return value(s) of the +entry point function. + +The context (void, scalar or list) of the thread creation is also the +context for C<-Ejoin()>. This means that if you intend to return an array +from a thread, you must use Ccreate(...)>, and that +if you intend to return a scalar, you must use C: + + # Create thread in list context + my ($thr1) = threads->create(sub { + my @results = qw(a b c); + return (@results); + }; + # Retrieve list results from thread + my @res1 = $thr1->join(); + + # Create thread in scalar context + my $thr2 = threads->create(sub { + my $result = 42; + return ($result); + }; + # Retrieve scalar result from thread + my $res2 = $thr2->join(); + +If the program exits without all other threads having been either joined or +detached, then a warning will be issued. (A program exits either because one +of its threads explicitly calls L, or in the case +of the main thread, reaches the end of the main program file.) =item $thread->detach Will make the thread unjoinable, and cause any eventual return value to be discarded. +Calling C<-Ejoin()> on a detached thread will cause an error to be thrown. + +=item threads->detach() + +Class method that allows a thread to detach itself. + =item threads->self This will return the thread object for the current thread. -=item $thread->tid +=item $thr->tid() + +Returns the ID of the thread. Thread IDs are unique integers with the main +thread in a program being 0, and incrementing by 1 for every thread created. -This will return the id of the thread. Thread IDs are integers, with -the main thread in a program being 0. Currently Perl assigns a unique -tid to every thread ever created in your program, assigning the first -thread to be created a tid of 1, and increasing the tid by 1 for each -new thread that's created. +=item threads->tid() -NB the class method C<< threads->tid() >> is a quick way to get the -current thread id if you don't have your thread object handy. +Class method that allows a thread to obtain its own ID. -=item threads->object( tid ) +=item threads->object($tid) -This will return the thread object for the thread associated with the -specified tid. Returns undef if there is no thread associated with the tid -or no tid is specified or the specified tid is undef. +This will return the I object for the I thread associated +with the specified thread ID. Returns C if there is no thread +associated with the TID, if the thread is joined or detached, if no TID is +specified or if the specified TID is undef. =item threads->yield(); @@ -198,6 +280,17 @@ code. This will return a list of all non joined, non detached threads. +=item $thr1->equal($thr2) + +Tests if two threads objects are the same thread or not. This is overloaded +to the more natural form: + + if ($thr1 == $thr2) { + print("Threads are the same\n"); + } + +(Thread comparison is based on thread IDs.) + =item async BLOCK; C creates a thread to execute the block immediately following @@ -220,16 +313,21 @@ exit from the main thread. =back -=head1 TODO +=head1 ERRORS + +=over 4 + +=item This Perl hasn't been configured and built properly for the threads... -The current implementation of threads has been an attempt to get -a correct threading system working that could be built on, -and optimized, in newer versions of perl. +The particular copy of Perl that you're trying to use was not built using the +C configuration option. -Currently the overhead of creating a thread is rather large, -also the cost of returning values can be large. These are areas -were there most likely will be work done to optimize what data -that needs to be cloned. +Having threads support requires all of Perl and all of the XS modules in the +Perl installation to be rebuilt; it is not just a question of adding the +L module (i.e., threaded and non-threaded Perls are binary +incompatible.) + +=back =head1 BUGS @@ -240,19 +338,11 @@ that needs to be cloned. On some platforms it might not be possible to destroy "parent" threads while there are still existing child "threads". -This will possibly be fixed in later versions of perl. - =item tid is I32 The thread id is a 32 bit integer, it can potentially overflow. This might be fixed in a later version of perl. -=item Returning objects - -When you return an object the entire stash that the object is blessed -as well. This will lead to a large memory usage. The ideal situation -would be to detect the original stash if it existed. - =item Creating threads inside BEGIN blocks Creating threads inside BEGIN blocks (or during the compilation phase @@ -266,33 +356,64 @@ If your Perl has been built with PERL_OLD_SIGNALS (one has to explicitly add that symbol to ccflags, see C), signal handling is not threadsafe. +=item Returning closures from threads + +Returning a closure from a thread does not work, usually crashing Perl in the +process. + +=item Perl Bugs and the CPAN Version of L + +Support for threads extents beyond the code in this module (i.e., +F and F), and into the Perl iterpreter itself. Older +versions of Perl contain bugs that may manifest themselves despite using the +latest version of L from CPAN. There is no workaround for this other +than upgrading to the lastest version of Perl. + +(Before you consider posting a bug report, please consult, and possibly post a +message to the discussion forum to see if what you've encountered is a known +problem.) + =back -=head1 AUTHOR and COPYRIGHT +=head1 REQUIREMENTS -Arthur Bergman Esky at nanisky.comE +Perl 5.8.0 or later -threads is released under the same license as Perl. +=head1 SEE ALSO -Thanks to +L Discussion Forum on CPAN: +L -Richard Soderberg Eperl at crystalflame.netE -Helping me out tons, trying to find reasons for races and other weird bugs! +Annotated POD for L: +L -Simon Cozens Esimon at brecon.co.ukE -Being there to answer zillions of annoying questions +L, L -Rocco Caputo Etroc at netrus.netE +L and +L -Vipul Ved Prakash Email at vipul.netE -Helping with debugging. +Perl threads mailing list: +L -please join perl-ithreads@perl.org for more information +=head1 AUTHOR -=head1 SEE ALSO +Artur Bergman Esky AT crucially DOT netE + +threads is released under the same license as Perl. + +CPAN version produced by Jerry D. Hedden + +=head1 ACKNOWLEDGEMENTS + +Richard Soderberg Eperl AT crystalflame DOT netE - +Helping me out tons, trying to find reasons for races and other weird bugs! + +Simon Cozens Esimon AT brecon DOT co DOT ukE - +Being there to answer zillions of annoying questions + +Rocco Caputo Etroc AT netrus DOT netE -L, L, -L, -L, L, L +Vipul Ved Prakash Email AT vipul DOT netE - +Helping with debugging =cut diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 4ecb488..0cbe208 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -2,6 +2,12 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#ifdef HAS_PPPORT_H +# define NEED_newRV_noinc +# define NEED_sv_2pv_nolen +# include "ppport.h" +# include "threads.h" +#endif #ifdef USE_ITHREADS