develooper Front page | perl.perl5.porters | Postings from March 2006

[PATCH] (2nd revised) 1st patch to sync blead 'threads' with CPAN

Thread Next
From:
Jerry D. Hedden
Date:
March 23, 2006 08:20
Subject:
[PATCH] (2nd revised) 1st patch to sync blead 'threads' with CPAN
Message ID:
20060323091954.fb30e530d17747c2b054d625b8945d88.884826707f.wbe@email.email.secureserver.net
diff -ur perl-current/ext/threads/Changes perl-patch1/ext/threads/Changes
--- perl-current/ext/threads/Changes	2001-09-18 11:18:50.000000000 -0400
+++ perl-patch1/ext/threads/Changes	2006-03-23 10:33:02.000000000 -0500
@@ -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 -ur perl-current/ext/threads/Makefile.PL perl-patch1/ext/threads/Makefile.PL
--- perl-current/ext/threads/Makefile.PL	2003-04-03 01:11:50.000000000 -0500
+++ perl-patch1/ext/threads/Makefile.PL	2006-03-23 10:32:26.000000000 -0500
@@ -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  <artur@contiller.se>') : ()),
-    '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 <sky AT crucially DOT net>',
+    '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 -ur perl-current/ext/threads/README perl-patch1/ext/threads/README
--- perl-current/ext/threads/README	2001-09-18 11:18:50.000000000 -0400
+++ perl-patch1/ext/threads/README	2006-03-23 10:33:08.000000000 -0500
@@ -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 @@
 
 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 <sky AT crucially DOT net>
+Same licence as Perl.
+
+CPAN version produced by Jerry D. Hedden <jdhedden AT cpan DOT org>
+
+# EOF
diff -ur perl-current/ext/threads/t/basic.t perl-patch1/ext/threads/t/basic.t
--- perl-current/ext/threads/t/basic.t	2003-06-07 10:24:22.000000000 -0400
+++ perl-patch1/ext/threads/t/basic.t	2006-03-21 17:05:38.000000000 -0500
@@ -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 @@
 }
 
 use ExtUtils::testlib;
-use strict;
-BEGIN { $| = 1; print "1..19\n" };
+
+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 test1 {
 	ok(2,'bar' eq $_[0],"Test that argument passing works");
 }
@@ -60,12 +64,12 @@
 	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 @@
 		      })->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 -ur perl-current/ext/threads/t/end.t perl-patch1/ext/threads/t/end.t
--- perl-current/ext/threads/t/end.t	2004-10-31 07:47:04.000000000 -0500
+++ perl-patch1/ext/threads/t/end.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
     $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 -ur perl-current/ext/threads/t/join.t perl-patch1/ext/threads/t/join.t
--- perl-current/ext/threads/t/join.t	2005-05-12 15:37:24.000000000 -0400
+++ perl-patch1/ext/threads/t/join.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 -ur perl-current/ext/threads/t/libc.t perl-patch1/ext/threads/t/libc.t
--- perl-current/ext/threads/t/libc.t	2003-06-07 09:59:14.000000000 -0400
+++ perl-patch1/ext/threads/t/libc.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 }
 
 use ExtUtils::testlib;
-use strict;
+
 BEGIN { $| = 1; print "1..11\n"};
 
 use threads;
diff -ur perl-current/ext/threads/t/list.t perl-patch1/ext/threads/t/list.t
--- perl-current/ext/threads/t/list.t	2003-06-07 10:24:22.000000000 -0400
+++ perl-patch1/ext/threads/t/list.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 
 use ExtUtils::testlib;
 
-use strict;
 
 
 BEGIN { $| = 1; print "1..8\n" };
diff -ur perl-current/ext/threads/t/problems.t perl-patch1/ext/threads/t/problems.t
--- perl-current/ext/threads/t/problems.t	2006-03-16 03:34:18.000000000 -0500
+++ perl-patch1/ext/threads/t/problems.t	2006-03-22 11:13:38.000000000 -0500
@@ -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 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 @@
 	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 @@
 # 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 @@
 # 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 -ur perl-current/ext/threads/t/stress_cv.t perl-patch1/ext/threads/t/stress_cv.t
--- perl-current/ext/threads/t/stress_cv.t	2003-06-07 09:59:14.000000000 -0400
+++ perl-patch1/ext/threads/t/stress_cv.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 }
 
 use ExtUtils::testlib;
-use strict;
+
 BEGIN { print "1..64\n" };
 use threads;
 
diff -ur perl-current/ext/threads/t/stress_re.t perl-patch1/ext/threads/t/stress_re.t
--- perl-current/ext/threads/t/stress_re.t	2003-06-07 09:59:14.000000000 -0400
+++ perl-patch1/ext/threads/t/stress_re.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 }
 
 use ExtUtils::testlib;
-use strict;
+
 BEGIN { print "1..64\n" };
 use threads;
 
diff -ur perl-current/ext/threads/t/stress_string.t perl-patch1/ext/threads/t/stress_string.t
--- perl-current/ext/threads/t/stress_string.t	2003-06-07 09:59:14.000000000 -0400
+++ perl-patch1/ext/threads/t/stress_string.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 }
 
 use ExtUtils::testlib;
-use strict;
+
 BEGIN { print "1..64\n" };
 use threads;
 
diff -ur perl-current/ext/threads/t/thread.t perl-patch1/ext/threads/t/thread.t
--- perl-current/ext/threads/t/thread.t	2005-04-18 22:05:44.000000000 -0400
+++ perl-patch1/ext/threads/t/thread.t	2006-03-21 17:05:42.000000000 -0500
@@ -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 @@
 is($?, 0, 'coredump in global destruction');
 
 # test CLONE_SKIP() functionality
-
-{
+if ($] >= 5.008007) {
     my %c : shared;
     my %d : shared;
 
@@ -268,5 +272,13 @@
 	    )
 	}),
 	"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 -ur perl-current/ext/threads/threads.pm perl-patch1/ext/threads/threads.pm
--- perl-current/ext/threads/threads.pm	2006-03-16 23:43:56.000000000 -0500
+++ perl-patch1/ext/threads/threads.pm	2006-03-23 10:33:18.000000000 -0500
@@ -38,20 +38,43 @@
                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 @@
 
 $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();
 
-    threads->list();
+    my @threads = threads->list();
+
+    if ($thr1 == $thr2) {
+        ...
+    }
 
 =head1 DESCRIPTION
 
@@ -135,55 +171,101 @@
 
 =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<undef> if thread creation failed. The new() method is an
-alias for create().
-
-=item $thread->join
-
-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.
+This will create a new thread that will begin execution with the specified
+entry point function, and give it the I<ARGS> list as parameters.  It will
+return the corresponding threads object, or C<undef> if thread creation failed.
 
-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 C<my ($thread) = threads->new(...)>, and
-that if you intend to return a scalar, you must use C<my $thread = ...>.
-
-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.)
+I<FUNCTION> may either be the name of a function, an anonymous subroutine, or
+a code ref.
+
+    my $thr = threads->create('func_name', ...);
+        # or
+    my $thr = threads->create(sub { ... }, ...);
+        # or
+    my $thr = threads->create(\&func, ...);
+
+The thread may be created in I<list> context, or I<scalar> 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<-E<gt>join()> method describe below.
+
+Although a thread may be created in I<void> context, to do so you must
+I<chain> either the C<-E<gt>join()> or C<-E<gt>detach()> method to the
+C<-E<gt>create()> call:
 
+    threads->create(...)->join();
+
+The C<-E<gt>new()> method is an alias for C<-E<gt>create()>.
+
+=item $thr->join()
+
+This will wait for the corresponding thread to complete its execution.  When
+the thread finishes, C<-E<gt>join()> 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<-E<gt>join()>.  This means that if you intend to return an array
+from a thread, you must use C<my ($thr) = threads->create(...)>, and that
+if you intend to return a scalar, you must use C<my $thr = ...>:
+
+    # 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<exit()|perlfunc/"exit EXPR">, 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<-E<gt>join()> 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.
-
-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.
-
-=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.
+=item threads->tid()
+
+Class method that allows a thread to obtain its own ID.
+
+=item threads->object($tid)
+
+This will return the I<threads> object for the I<active> thread associated
+with the specified thread ID.  Returns C<undef> 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 @@
 
 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<async> creates a thread to execute the block immediately following
@@ -220,16 +313,21 @@
 
 =back
 
-=head1 TODO
+=head1 ERRORS
+
+=over 4
+
+=item This Perl hasn't been configured and built properly for the threads...
+
+The particular copy of Perl that you're trying to use was not built using the
+C<useithreads> configuration option.
 
-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.
-
-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<threads> module (i.e., threaded and non-threaded Perls are binary
+incompatible.)
+
+=back
 
 =head1 BUGS
 
@@ -240,19 +338,11 @@
 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 @@
 to explicitly add that symbol to ccflags, see C<perl -V>),
 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<threads>
+
+Support for threads extents beyond the code in this module (i.e.,
+F<threads.pm> and F<threads.xs>), and into the Perl iterpreter itself.  Older
+versions of Perl contain bugs that may manifest themselves despite using the
+latest version of L<threads> 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 E<lt>sky at nanisky.comE<gt>
+Perl 5.8.0 or later
 
-threads is released under the same license as Perl.
+=head1 SEE ALSO
 
-Thanks to
+L<threads> Discussion Forum on CPAN:
+L<http://www.cpanforum.com/dist/threads>
 
-Richard Soderberg E<lt>perl at crystalflame.netE<gt>
-Helping me out tons, trying to find reasons for races and other weird bugs!
+Annotated POD for L<threads>:
+L<http://annocpan.org/~JDHEDDEN/threads-1.17/shared.pm>
 
-Simon Cozens E<lt>simon at brecon.co.ukE<gt>
-Being there to answer zillions of annoying questions
+L<threads::shared>, L<perlthrtut>
 
-Rocco Caputo E<lt>troc at netrus.netE<gt>
+L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
+L<http://www.perl.com/pub/a/2002/09/04/threads.html>
 
-Vipul Ved Prakash E<lt>mail at vipul.netE<gt>
-Helping with debugging.
+Perl threads mailing list:
+L<http://lists.cpan.org/showlist.cgi?name=iThreads>
 
-please join perl-ithreads@perl.org for more information
+=head1 AUTHOR
 
-=head1 SEE ALSO
+Artur Bergman E<lt>sky AT crucially DOT netE<gt>
+
+threads is released under the same license as Perl.
+
+CPAN version produced by Jerry D. Hedden <jdhedden AT cpan DOT org>
+
+=head1 ACKNOWLEDGEMENTS
+
+Richard Soderberg E<lt>perl AT crystalflame DOT netE<gt> -
+Helping me out tons, trying to find reasons for races and other weird bugs!
+
+Simon Cozens E<lt>simon AT brecon DOT co DOT ukE<gt> -
+Being there to answer zillions of annoying questions
+
+Rocco Caputo E<lt>troc AT netrus DOT netE<gt>
 
-L<threads::shared>, L<perlthrtut>, 
-L<http://www.perl.com/pub/a/2002/06/11/threads.html>,
-L<perlcall>, L<perlembed>, L<perlguts>
+Vipul Ved Prakash E<lt>mail AT vipul DOT netE<gt> -
+Helping with debugging
 
 =cut
diff -ur perl-current/ext/threads/threads.xs perl-patch1/ext/threads/threads.xs
--- perl-current/ext/threads/threads.xs	2006-03-16 23:43:56.000000000 -0500
+++ perl-patch1/ext/threads/threads.xs	2006-03-23 10:24:40.000000000 -0500
@@ -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
 

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About