Updating lang/perl5 from 5.12.2 to 5.12.2nb1

pkgsrc changes:
- updating bundled modules
  * threads from 1.75 to 1.78
  * threads::shared from 1.32 to 1.33
  * Math::BigInt from 1.89_01 to 1.95 (without test merges)

Upstream changes of avove modules

>>> threads <<<
1.78 Wed Sep 22 17:21:22 2010
	- Handle missing signal handler in thread (threads bug #60460)

1.77 Fri Mar 26 13:36:33 2010
	- Fix race condition in t/threads.t (threads bug #55633)

1.76 Tue Mar  9 14:02:43 EST 2010
	- Handle magic on arg to ->object() (bug #73330)
	- Make ->object(threads->tid()) work like ->self() (bug #73330)
	- Noted memory consumption issue in POD
	- Added reusable thread pool example

>>> threads::shared <<<
1.33 Tue Mar  9 14:03:47 EST 2010
	- Handle shared object reference during global destruction
	- Document that changing array length via $#array doesn't work

>>> Math::BigInt <<<
2010-09-03 v1.90 rafl
 * fix bnok() for k==0 and k==n-1
2010-09-10 v1.91 rafl
 * fix various documentation bugs
2010-09-10 v1.92 rafl
 * re-upload v1.91 with a fixed SIGNATURE
2010-09-13 v1.93 rafl
 * Depend on perl >= 5.6.2
 * Remove obsolete core test directory boilerplate
 * Convert from Test to Test::More
2010-09-13 v1.94 rafl DEVELOPMENT RELEASE
 * Attempt to fix Math::BigInt::Lite failures
2010-09-14 v1.95 rafl
 * Re-upload v1.94 as a stable release

5 files changed, 1006 insertions, 3 deletions

diff --git a/lang/perl5/Makefile b/lang/perl5/Makefile
index 6dae13c06f0..e5a4edbd953 100644
--- a/lang/perl5/Makefile
+++ b/lang/perl5/Makefile
@@ -1,9 +1,9 @@
-# $NetBSD: Makefile,v 1.165 2010/09/09 20:35:43 sno Exp $
+# $NetBSD: Makefile,v 1.166 2010/09/23 21:47:48 sno Exp $
 
 .include "license.mk"
 .include "Makefile.common"
 
-#PKGREVISION=	2
+PKGREVISION=	1
 COMMENT=	Practical Extraction and Report Language
 
 PKG_DESTDIR_SUPPORT=	user-destdir
@@ -302,6 +302,9 @@ SUBST_SED.dirmode=	-e "s/755/${PKGDIRMODE}/g;/umask(/d"
 post-extract:
 		cp ${FILESDIR}/Policy.sh ${WRKSRC}/Policy.sh
 
+pre-configure:
+	cd ${WRKSRC} && find `pwd` -name "*.orig" -type f -exec ${RM} -f {} \;
+
 post-build:
 	${SED}	-e "s,@PERL5@,"${PERL5:Q}",g"				\
 		-e "s,@SH@,"${SH:Q}",g"					\
diff --git a/lang/perl5/distinfo b/lang/perl5/distinfo
index ca07b390b2f..5b55dd8b569 100644
--- a/lang/perl5/distinfo
+++ b/lang/perl5/distinfo
@@ -1,4 +1,4 @@
-$NetBSD: distinfo,v 1.70 2010/09/09 20:35:43 sno Exp $
+$NetBSD: distinfo,v 1.71 2010/09/23 21:47:48 sno Exp $
 
 SHA1 (perl-5.12.2.tar.gz) = c157f214a93ce20fc06dc9d9c902c05ad1327cb1
 RMD160 (perl-5.12.2.tar.gz) = b1fd7f05d96fa6a263d3622654af6b584c308ce4
@@ -14,6 +14,9 @@ SHA1 (patch-ch) = 5b6a89c82e158bab0a5f06add48c28e600678099
 SHA1 (patch-ck) = 28207b8186c9ad194a1edc696159915bc16d1097
 SHA1 (patch-cn) = 7ca2b1ff19f8371637a34ec26779b37d74c74cca
 SHA1 (patch-cp) = 0b22d334df24d128142855464bf6dd61d4d82975
+SHA1 (patch-dm) = 8e8a0ede0f371ef0ad3a0433912967f3b8f3dd43
+SHA1 (patch-ds) = e14502548e2b9579b9ac654bbc83d78cd249e8ab
+SHA1 (patch-dt) = 5be484f0e251871f0be83688fa01a45ff88f4eca
 SHA1 (patch-ta) = 69f0d2df022eb8ff0dbcc77bde638cdc9c6391b1
 SHA1 (patch-zc) = 187b79978285058f37991278b99bbd4109344a2f
 SHA1 (patch-zd) = 15532739b4a582da322d3e51fc364905bacbcd7e
diff --git a/lang/perl5/patches/patch-dm b/lang/perl5/patches/patch-dm
new file mode 100644
index 00000000000..4c04b63d36f
--- /dev/null
+++ b/lang/perl5/patches/patch-dm
@@ -0,0 +1,280 @@
+$NetBSD: patch-dm,v 1.1 2010/09/23 21:47:48 sno Exp $
+
+Update Math::BigInt to 1.95
+
+--- cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm.orig	2010-09-05 15:14:32.000000000 +0000
++++ cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
+@@ -5,7 +5,7 @@ use strict;
+ # use warnings;	# dont use warnings for older Perls
+ use vars qw/$VERSION/;
+ 
+-$VERSION = '0.05';
++$VERSION = '0.06';
+ 
+ package Math::BigInt;
+ 
+--- cpan/Math-BigInt/lib/Math/BigInt/Calc.pm.orig	2010-09-05 15:14:32.000000000 +0000
++++ cpan/Math-BigInt/lib/Math/BigInt/Calc.pm
+@@ -1,10 +1,10 @@
+ package Math::BigInt::Calc;
+ 
+-use 5.006;
++use 5.006002;
+ use strict;
+ # use warnings;	# dont use warnings for older Perls
+ 
+-our $VERSION = '0.52';
++our $VERSION = '0.54';
+ 
+ # Package to store unsigned big integers in decimal and do math with them
+ 
+@@ -1264,7 +1264,7 @@ sub _is_even
+ 
+ sub _is_odd
+   {
+-  # return true if arg is even
++  # return true if arg is odd
+   (($_[1]->[0] & 1)) <=> 0; 
+   }
+ 
+@@ -1536,22 +1536,20 @@ sub _nok
+   # ref to array, return ref to array
+   my ($c,$n,$k) = @_;
+ 
+-  # ( 7 )    7!          7*6*5 * 4*3*2*1   7 * 6 * 5
+-  # ( - ) = --------- =  --------------- = ---------
+-  # ( 3 )   3! (7-3)!    3*2*1 * 4*3*2*1   3 * 2 * 1 
++  # ( 7 )       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
++  # ( - ) = --------- =  --------------- = --------- = 5 * - * -
++  # ( 3 )   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3
+ 
+-  # compute n - k + 2 (so we start with 5 in the example above)
++  if (!_is_zero($c,$k))
++    {
+   my $x = _copy($c,$n);
+-
+   _sub($c,$n,$k);
+-  if (!_is_one($c,$n))
+-    {
+     _inc($c,$n);
+     my $f = _copy($c,$n); _inc($c,$f);		# n = 5, f = 6, d = 2
+     my $d = _two($c);
+-    while (_acmp($c,$f,$x) <= 0)		# f < n ?
++    while (_acmp($c,$f,$x) <= 0)		# f <= n ?
+       {
+-      # n = (n * f / d) == 5 * 6 / 2 => n == 3
++      # n = (n * f / d) == 5 * 6 / 2
+       $n = _mul($c,$n,$f); $n = _div($c,$n,$d);
+       # f = 7, d = 3
+       _inc($c,$f); _inc($c,$d);
+--- cpan/Math-BigInt/lib/Math/BigInt.pm.orig	2010-09-05 15:14:32.000000000 +0000
++++ cpan/Math-BigInt/lib/Math/BigInt.pm
+@@ -16,9 +16,9 @@ package Math::BigInt;
+ # underlying lib might change the reference!
+ 
+ my $class = "Math::BigInt";
+-use 5.006;
++use 5.006002;
+ 
+-$VERSION = '1.89_01';
++$VERSION = '1.95';
+ 
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(objectify bgcd blcm); 
+@@ -1260,7 +1260,7 @@ sub blog
+   # objectify is costly, so avoid it
+   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+     {
+-    ($self,$x,$base,@r) = objectify(1,ref($x),@_);
++    ($self,$x,$base,@r) = objectify(2,@_);
+     }
+ 
+   return $x if $x->modify('blog');
+@@ -1320,18 +1320,17 @@ sub bnok
+     }
+   else
+     {
+-    # ( 7 )    7!          7*6*5 * 4*3*2*1   7 * 6 * 5
+-    # ( - ) = --------- =  --------------- = ---------
+-    # ( 3 )   3! (7-3)!    3*2*1 * 4*3*2*1   3 * 2 * 1 
+-
+-    # compute n - k + 2 (so we start with 5 in the example above)
+-    my $z = $x - $y;
+-    if (!$z->is_one())
++    # ( 7 )       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
++    # ( - ) = --------- =  --------------- = --------- = 5 * - * -
++    # ( 3 )   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3
++
++    if (!$y->is_zero())
+       {
++      my $z = $x - $y;
+       $z->binc();
+       my $r = $z->copy(); $z->binc();
+       my $d = $self->new(2);
+-      while ($z->bacmp($x) <= 0)		# f < x ?
++      while ($z->bacmp($x) <= 0)		# f <= x ?
+         {
+         $r->bmul($z); $r->bdiv($d);
+         $z->binc(); $d->binc();
+@@ -1375,11 +1374,11 @@ sub bexp
+   else { $x = $u; }
+   }
+ 
+-sub blcm 
+-  { 
++sub blcm
++  {
+   # (BINT or num_str, BINT or num_str) return BINT
+   # does not modify arguments, but returns new object
+-  # Lowest Common Multiplicator
++  # Lowest Common Multiple
+ 
+   my $y = shift; my ($x);
+   if (ref($y))
+@@ -1498,13 +1497,13 @@ sub is_even
+ 
+ sub is_positive
+   {
+-  # return true when arg (BINT or num_str) is positive (>= 0)
++  # return true when arg (BINT or num_str) is positive (> 0)
+   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ 
+   return 1 if $x->{sign} eq '+inf';			# +inf is positive
+- 
++
+   # 0+ is neither positive nor negative
+-  ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;	
++  ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
+   }
+ 
+ sub is_negative
+@@ -3136,8 +3135,8 @@ Math::BigInt - Arbitrary size integer/fl
+   $x->is_one('-');	# if $x is -1
+   $x->is_odd();		# if $x is odd
+   $x->is_even();	# if $x is even
+-  $x->is_pos();		# if $x >= 0
+-  $x->is_neg();		# if $x <  0
++  $x->is_pos();		# if $x > 0
++  $x->is_neg();		# if $x < 0
+   $x->is_inf($sign);	# if $x is +inf, or -inf (sign is default '+')
+   $x->is_int();		# if $x is an integer (not a float)
+ 
+@@ -3212,14 +3211,14 @@ Math::BigInt - Arbitrary size integer/fl
+ 
+   $x->bfloor();		   # return integer less or equal than $x
+   $x->bceil();		   # return integer greater or equal than $x
+-  
++
+   # The following do not modify their arguments:
+ 
+   # greatest common divisor (no OO style)
+   my $gcd = Math::BigInt::bgcd(@values);
+-  # lowest common multiplicator (no OO style)
+-  my $lcm = Math::BigInt::blcm(@values);	
+- 
++  # lowest common multiple (no OO style)
++  my $lcm = Math::BigInt::blcm(@values);
++
+   $x->length();		   # return number of digits in number
+   ($xl,$f) = $x->length(); # length of number and length of fraction part,
+ 			   # latter is always 0 digits long for BigInts
+@@ -3393,15 +3392,15 @@ to the math operation as additional para
+         print scalar $x->copy()->bdiv($y, 2);		# print 4300
+         print scalar $x->copy()->bdiv($y)->bround(2);	# print 4300
+ 
+-Please see the section about L<ACCURACY AND PRECISION> for further details.
++Please see the section about L<ACCURACY and PRECISION> for further details.
+ 
+ Value must be greater than zero. Pass an undef value to disable it:
+ 
+ 	$x->accuracy(undef);
+ 	Math::BigInt->accuracy(undef);
+ 
+-Returns the current accuracy. For C<$x->accuracy()> it will return either the
+-local accuracy, or if not defined, the global. This means the return value
++Returns the current accuracy. For C<< $x->accuracy() >> it will return either
++the local accuracy, or if not defined, the global. This means the return value
+ represents the accuracy that will be in effect for $x:
+ 
+ 	$y = Math::BigInt->new(1234567);	# unrounded
+@@ -3443,15 +3442,15 @@ In Math::BigInt, passing a negative numb
+ numbers have digits after the dot. In L<Math::BigFloat>, it will round all
+ results to P digits after the dot.
+ 
+-Please see the section about L<ACCURACY AND PRECISION> for further details.
++Please see the section about L<ACCURACY and PRECISION> for further details.
+ 
+ Pass an undef value to disable it:
+ 
+ 	$x->precision(undef);
+ 	Math::BigInt->precision(undef);
+ 
+-Returns the current precision. For C<$x->precision()> it will return either the
+-local precision of $x, or if not defined, the global. This means the return
++Returns the current precision. For C<< $x->precision() >> it will return either
++the local precision of $x, or if not defined, the global. This means the return
+ value represents the prevision that will be in effect for $x:
+ 
+ 	$y = Math::BigInt->new(1234567);	# unrounded
+@@ -3509,7 +3508,7 @@ See L<Input> for more info on accepted i
+ 
+ =head2 from_bin()
+ 
+-	$x = Math::BigInt->from_oct("0x10011");	# input is binary
++	$x = Math::BigInt->from_bin("0x10011");	# input is binary
+ 
+ =head2 bnan()
+ 
+@@ -3605,7 +3604,7 @@ Returns -1, 0, 1 or undef.
+ 
+ 	$x->bacmp($y);
+ 
+-Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
++Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef.
+ 
+ =head2 sign()
+ 
+@@ -3912,8 +3911,8 @@ does change $x in BigFloat.
+ 
+ =head2 blcm()
+ 
+-	blcm(@values);		# lowest common multiplicator (no OO style)
+- 
++	blcm(@values);		# lowest common multiple (no OO style)
++
+ head2 length()
+ 
+ 	$x->length();
+@@ -4654,8 +4653,8 @@ directly.
+ 
+ =item *
+ 
+-The private object hash keys like C<$x->{sign}> may not be changed, but
+-additional keys can be added, like C<$x->{_custom}>.
++The private object hash keys like C<< $x->{sign} >> may not be changed, but
++additional keys can be added, like C<< $x->{_custom} >>.
+ 
+ =item *
+ 
+--- cpan/Math-BigInt/lib/Math/BigFloat.pm.orig	2010-09-05 15:14:32.000000000 +0000
++++ cpan/Math-BigInt/lib/Math/BigFloat.pm
+@@ -12,8 +12,8 @@ package Math::BigFloat;
+ #   _a	: accuracy
+ #   _p	: precision
+ 
+-$VERSION = '1.60';
+-require 5.006;
++$VERSION = '1.62';
++require 5.006002;
+ 
+ require Exporter;
+ @ISA		= qw/Math::BigInt/;
+@@ -3905,7 +3905,7 @@ Some routines (C<is_odd()>, C<is_even()>
+ C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
+ return either undef, <0, 0 or >0 and are suited for sort.
+ 
+-Actual math is done by using the class defined with C<with => Class;> (which
++Actual math is done by using the class defined with C<< with => Class; >> (which
+ defaults to BigInts) to represent the mantissa and exponent.
+ 
+ The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to 
diff --git a/lang/perl5/patches/patch-ds b/lang/perl5/patches/patch-ds
new file mode 100644
index 00000000000..2e17eaa7c3f
--- /dev/null
+++ b/lang/perl5/patches/patch-ds
@@ -0,0 +1,109 @@
+$NetBSD: patch-ds,v 1.1 2010/09/23 21:47:48 sno Exp $
+
+Update of threads::shared to 1.33
+
+--- dist/threads-shared/shared.pm.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads-shared/shared.pm
+@@ -7,7 +7,7 @@ use warnings;
+ 
+ use Scalar::Util qw(reftype refaddr blessed);
+ 
+-our $VERSION = '1.32';
++our $VERSION = '1.33';
+ my $XS_VERSION = $VERSION;
+ $VERSION = eval $VERSION;
+ 
+@@ -187,7 +187,7 @@ threads::shared - Perl extension for sha
+ 
+ =head1 VERSION
+ 
+-This document describes threads::shared version 1.32
++This document describes threads::shared version 1.33
+ 
+ =head1 SYNOPSIS
+ 
+@@ -527,7 +527,8 @@ that the contents of hash-based objects 
+ mentioned limitation.  See F<examples/class.pl> (in the CPAN distribution of
+ this module) for how to create a class that supports object sharing.
+ 
+-Does not support C<splice> on arrays!
++Does not support C<splice> on arrays.  Does not support explicitly changing
++array lengths via $#array -- use C<push> and C<pop> instead.
+ 
+ Taking references to the elements of shared arrays and hashes does not
+ autovivify the elements, and neither does slicing a shared array/hash over
+@@ -588,7 +589,7 @@ L<threads::shared> Discussion Forum on C
+ L<http://www.cpanforum.com/dist/threads-shared>
+ 
+ Annotated POD for L<threads::shared>:
+-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.32/shared.pm>
++L<http://annocpan.org/~JDHEDDEN/threads-shared-1.33/shared.pm>
+ 
+ Source repository:
+ L<http://code.google.com/p/threads-shared/>
+--- dist/threads-shared/shared.xs.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads-shared/shared.xs
+@@ -864,29 +864,32 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAG
+ {
+     dTHXc;
+     SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+-    SV** svp;
++    SV** svp = NULL;
+ 
+     ENTER_LOCK;
+-    if (SvTYPE(saggregate) == SVt_PVAV) {
+-        assert ( mg->mg_ptr == 0 );
+-        SHARED_CONTEXT;
+-        svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
+-    } else {
+-        char *key = mg->mg_ptr;
+-        I32 len = mg->mg_len;
+-        assert ( mg->mg_ptr != 0 );
+-        if (mg->mg_len == HEf_SVKEY) {
+-            STRLEN slen;
+-            key = SvPV((SV *)mg->mg_ptr, slen);
+-            len = slen;
+-            if (SvUTF8((SV *)mg->mg_ptr)) {
+-                len = -len;
++    if (saggregate) {  /* During global destruction, underlying
++                          aggregate may no longer exist */
++        if (SvTYPE(saggregate) == SVt_PVAV) {
++            assert ( mg->mg_ptr == 0 );
++            SHARED_CONTEXT;
++            svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
++        } else {
++            char *key = mg->mg_ptr;
++            I32 len = mg->mg_len;
++            assert ( mg->mg_ptr != 0 );
++            if (mg->mg_len == HEf_SVKEY) {
++                STRLEN slen;
++                key = SvPV((SV *)mg->mg_ptr, slen);
++                len = slen;
++                if (SvUTF8((SV *)mg->mg_ptr)) {
++                    len = -len;
++                }
+             }
++            SHARED_CONTEXT;
++            svp = hv_fetch((HV*) saggregate, key, len, 0);
+         }
+-        SHARED_CONTEXT;
+-        svp = hv_fetch((HV*) saggregate, key, len, 0);
++        CALLER_CONTEXT;
+     }
+-    CALLER_CONTEXT;
+     if (svp) {
+         /* Exists in the array */
+         if (SvROK(*svp)) {
+@@ -957,6 +960,12 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MA
+     dTHXc;
+     MAGIC *shmg;
+     SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
++
++    /* Object may not exist during global destruction */
++    if (! saggregate) {
++        return (0);
++    }
++
+     ENTER_LOCK;
+     sharedsv_elem_mg_FETCH(aTHX_ sv, mg);
+     if ((shmg = mg_find(sv, PERL_MAGIC_shared_scalar)))
diff --git a/lang/perl5/patches/patch-dt b/lang/perl5/patches/patch-dt
new file mode 100644
index 00000000000..d24957c5159
--- /dev/null
+++ b/lang/perl5/patches/patch-dt
@@ -0,0 +1,608 @@
+$NetBSD: patch-dt,v 1.1 2010/09/23 21:47:48 sno Exp $
+
+update of threads to 1.78
+
+--- dist/threads/t/thread.t.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads/t/thread.t
+@@ -20,7 +20,7 @@ BEGIN {
+     }
+ 
+     $| = 1;
+-    print("1..34\n");   ### Number of tests that will be run ###
++    print("1..35\n");   ### Number of tests that will be run ###
+ };
+ 
+ print("ok 1 - Loaded\n");
+@@ -161,7 +161,7 @@ package main;
+ 
+ # bugid #24165
+ 
+-run_perl(prog => 'use threads 1.75;' .
++run_perl(prog => 'use threads 1.78;' .
+                  'sub a{threads->create(shift)} $t = a sub{};' .
+                  '$t->tid; $t->join; $t->tid',
+          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+@@ -304,6 +304,26 @@ SKIP: {
+         "counts of calls to DESTROY");
+ }
+ 
++# Bug 73330 - Apply magic to arg to ->object()
++{
++    my @tids :shared;
++
++    my $thr = threads->create(sub {
++                        lock(@tids);
++                        push(@tids, threads->tid());
++                        cond_signal(@tids);
++                    });
++
++    {
++        lock(@tids);
++        cond_wait(@tids) while (! @tids);
++    }
++
++    ok(threads->object($_), 'Got threads object') foreach (@tids);
++
++    $thr->join();
++}
++
+ exit(0);
+ 
+ # EOF
+--- dist/threads/t/exit.t.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads/t/exit.t
+@@ -48,7 +48,7 @@ my $rc = $thr->join();
+ ok(! defined($rc), 'Exited: threads->exit()');
+ 
+ 
+-run_perl(prog => 'use threads 1.75;' .
++run_perl(prog => 'use threads 1.78;' .
+                  'threads->exit(86);' .
+                  'exit(99);',
+          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+@@ -98,7 +98,7 @@ $rc = $thr->join();
+ ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
+ 
+ 
+-run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
++run_perl(prog => 'use threads 1.78 qw(exit thread_only);' .
+                  'threads->create(sub { exit(99); })->join();' .
+                  'exit(86);',
+          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
+@@ -108,7 +108,7 @@ run_perl(prog => 'use threads 1.75 qw(ex
+     is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
+ }
+ 
+-my $out = run_perl(prog => 'use threads 1.75;' .
++my $out = run_perl(prog => 'use threads 1.78;' .
+                            'threads->create(sub {' .
+                            '    exit(99);' .
+                            '});' .
+@@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 
+ like($out, '1 finished and unjoined', "exit(status) in thread");
+ 
+ 
+-$out = run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
++$out = run_perl(prog => 'use threads 1.78 qw(exit thread_only);' .
+                         'threads->create(sub {' .
+                         '   threads->set_thread_exit_only(0);' .
+                         '   exit(99);' .
+@@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 1.7
+ like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
+ 
+ 
+-run_perl(prog => 'use threads 1.75;' .
++run_perl(prog => 'use threads 1.78;' .
+                  'threads->create(sub {' .
+                  '   $SIG{__WARN__} = sub { exit(99); };' .
+                  '   die();' .
+--- dist/threads/t/basic.t.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads/t/basic.t
+@@ -27,7 +27,7 @@ sub ok {
+ 
+ BEGIN {
+     $| = 1;
+-    print("1..33\n");   ### Number of tests that will be run ###
++    print("1..34\n");   ### Number of tests that will be run ###
+ };
+ 
+ use threads;
+@@ -153,14 +153,17 @@ $thrx = threads->object();
+ ok(30, ! defined($thrx), 'No object');
+ $thrx = threads->object(undef);
+ ok(31, ! defined($thrx), 'No object');
+-$thrx = threads->object(0);
+-ok(32, ! defined($thrx), 'No object');
+ 
+ threads->import('stringify');
+ $thr1 = threads->create(sub {});
+-ok(33, "$thr1" eq $thr1->tid(), 'Stringify');
++ok(32, "$thr1" eq $thr1->tid(), 'Stringify');
+ $thr1->join();
+ 
++# ->object($tid) works like ->self() when $tid is thread's TID
++$thrx = threads->object(threads->tid());
++ok(33, defined($thrx), 'Main thread object');
++ok(34, 0 == $thrx->tid(), "Check so that tid for threads work for main thread");
++
+ exit(0);
+ 
+ # EOF
+--- dist/threads/threads.xs.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads/threads.xs
+@@ -52,7 +52,7 @@ typedef perl_os_thread pthread_t;
+ 
+ /* Values for 'state' member */
+ #define PERL_ITHR_DETACHED           1 /* Thread has been detached */
+-#define PERL_ITHR_JOINED             2 /* Thread has been joined */
++#define PERL_ITHR_JOINED             2 /* Thread is being / has been joined */
+ #define PERL_ITHR_FINISHED           4 /* Thread has finished execution */
+ #define PERL_ITHR_THREAD_EXIT_ONLY   8 /* exit() only exits current thread */
+ #define PERL_ITHR_NONVIABLE         16 /* Thread creation failed */
+@@ -71,7 +71,7 @@ typedef struct _ithread {
+     int state;                  /* Detached, joined, finished, etc. */
+     int gimme;                  /* Context of create */
+     SV *init_function;          /* Code to run */
+-    SV *params;                 /* Args to pass function */
++    AV *params;                 /* Args to pass function */
+ #ifdef WIN32
+     DWORD  thr;                 /* OS's idea if thread id */
+     HANDLE handle;              /* OS's waitable handle */
+@@ -215,7 +215,7 @@ S_ithread_clear(pTHX_ ithread *thread)
+         S_ithread_set(aTHX_ thread);
+ 
+         SvREFCNT_dec(thread->params);
+-        thread->params = Nullsv;
++        thread->params = NULL;
+ 
+         if (thread->err) {
+             SvREFCNT_dec(thread->err);
+@@ -487,7 +487,7 @@ S_ithread_run(void * arg)
+     PL_perl_destruct_level = 2;
+ 
+     {
+-        AV *params = (AV *)SvRV(thread->params);
++        AV *params = thread->params;
+         int len = (int)av_len(params)+1;
+         int ii;
+ 
+@@ -675,10 +675,13 @@ S_ithread_create(
+         IV        stack_size,
+         int       gimme,
+         int       exit_opt,
+-        SV       *params)
++        SV      **params_start,
++        SV      **params_end)
+ {
+     ithread     *thread;
+     ithread     *current_thread = S_ithread_get(aTHX);
++    AV          *params;
++    SV          **array;
+ 
+ #if PERL_VERSION <= 8 && PERL_SUBVERSION <= 7
+     SV         **tmps_tmp = PL_tmps_stack;
+@@ -781,7 +784,7 @@ S_ithread_create(
+          * they are created
+          */
+         SvREFCNT_dec(PL_endav);
+-        PL_endav = newAV();
++        PL_endav = NULL;
+ 
+         clone_param.flags = 0;
+         if (SvPOK(init_function)) {
+@@ -792,8 +795,13 @@ S_ithread_create(
+                 SvREFCNT_inc(sv_dup(init_function, &clone_param));
+         }
+ 
+-        thread->params = sv_dup(params, &clone_param);
+-        SvREFCNT_inc_void(thread->params);
++        thread->params = params = newAV();
++        av_extend(params, params_end - params_start - 1);
++        AvFILLp(params) = params_end - params_start - 1;
++        array = AvARRAY(params);
++        while (params_start < params_end) {
++            *array++ = SvREFCNT_inc(sv_dup(*params_start++, &clone_param));
++        }
+ 
+ #if PERL_VERSION <= 8 && PERL_SUBVERSION <= 7
+         /* The code below checks that anything living on the tmps stack and
+@@ -908,7 +916,6 @@ S_ithread_create(
+ #endif
+         /* Must unlock mutex for destruct call */
+         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
+-        sv_2mortal(params);
+         thread->state |= PERL_ITHR_NONVIABLE;
+         S_ithread_free(aTHX_ thread);   /* Releases MUTEX */
+ #ifndef WIN32
+@@ -924,7 +931,6 @@ S_ithread_create(
+     }
+ 
+     MY_POOL.running_threads++;
+-    sv_2mortal(params);
+     return (thread);
+ }
+ 
+@@ -942,7 +948,6 @@ ithread_create(...)
+         char *classname;
+         ithread *thread;
+         SV *function_to_call;
+-        AV *params;
+         HV *specs;
+         IV stack_size;
+         int context;
+@@ -950,7 +955,8 @@ ithread_create(...)
+         SV *thread_exit_only;
+         char *str;
+         int idx;
+-        int ii;
++        SV **args_start;
++        SV **args_end;
+         dMY_POOL;
+     CODE:
+         if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) {
+@@ -988,18 +994,19 @@ ithread_create(...)
+ 
+         context = -1;
+         if (specs) {
++            SV **svp;
+             /* stack_size */
+-            if (hv_exists(specs, "stack", 5)) {
+-                stack_size = SvIV(*hv_fetch(specs, "stack", 5, 0));
+-            } else if (hv_exists(specs, "stacksize", 9)) {
+-                stack_size = SvIV(*hv_fetch(specs, "stacksize", 9, 0));
+-            } else if (hv_exists(specs, "stack_size", 10)) {
+-                stack_size = SvIV(*hv_fetch(specs, "stack_size", 10, 0));
++            if ((svp = hv_fetch(specs, "stack", 5, 0))) {
++                stack_size = SvIV(*svp);
++            } else if ((svp = hv_fetch(specs, "stacksize", 9, 0))) {
++                stack_size = SvIV(*svp);
++            } else if ((svp = hv_fetch(specs, "stack_size", 10, 0))) {
++                stack_size = SvIV(*svp);
+             }
+ 
+             /* context */
+-            if (hv_exists(specs, "context", 7)) {
+-                str = (char *)SvPV_nolen(*hv_fetch(specs, "context", 7, 0));
++            if ((svp = hv_fetch(specs, "context", 7, 0))) {
++                str = (char *)SvPV_nolen(*svp);
+                 switch (*str) {
+                     case 'a':
+                     case 'A':
+@@ -1018,27 +1025,27 @@ ithread_create(...)
+                     default:
+                         Perl_croak(aTHX_ "Invalid context: %s", str);
+                 }
+-            } else if (hv_exists(specs, "array", 5)) {
+-                if (SvTRUE(*hv_fetch(specs, "array", 5, 0))) {
++            } else if ((svp = hv_fetch(specs, "array", 5, 0))) {
++                if (SvTRUE(*svp)) {
+                     context = G_ARRAY;
+                 }
+-            } else if (hv_exists(specs, "list", 4)) {
+-                if (SvTRUE(*hv_fetch(specs, "list", 4, 0))) {
++            } else if ((svp = hv_fetch(specs, "list", 4, 0))) {
++                if (SvTRUE(*svp)) {
+                     context = G_ARRAY;
+                 }
+-            } else if (hv_exists(specs, "scalar", 6)) {
+-                if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) {
++            } else if ((svp = hv_fetch(specs, "scalar", 6, 0))) {
++                if (SvTRUE(*svp)) {
+                     context = G_SCALAR;
+                 }
+-            } else if (hv_exists(specs, "void", 4)) {
+-                if (SvTRUE(*hv_fetch(specs, "void", 4, 0))) {
++            } else if ((svp = hv_fetch(specs, "void", 4, 0))) {
++                if (SvTRUE(*svp)) {
+                     context = G_VOID;
+                 }
+             }
+ 
+             /* exit => thread_only */
+-            if (hv_exists(specs, "exit", 4)) {
+-                str = (char *)SvPV_nolen(*hv_fetch(specs, "exit", 4, 0));
++            if ((svp = hv_fetch(specs, "exit", 4, 0))) {
++                str = (char *)SvPV_nolen(*svp);
+                 exit_opt = (*str == 't' || *str == 'T')
+                                     ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
+             }
+@@ -1050,11 +1057,11 @@ ithread_create(...)
+         }
+ 
+         /* Function args */
+-        params = newAV();
++        args_start = &ST(idx + 2);
+         if (items > 2) {
+-            for (ii=2; ii < items ; ii++) {
+-                av_push(params, SvREFCNT_inc(ST(idx+ii)));
+-            }
++            args_end = &ST(idx + items);
++        } else {
++            args_end = args_start;
+         }
+ 
+         /* Create thread */
+@@ -1063,7 +1070,8 @@ ithread_create(...)
+                                         stack_size,
+                                         context,
+                                         exit_opt,
+-                                        newRV_noinc((SV*)params));
++                                        args_start,
++                                        args_end);
+         if (! thread) {
+             XSRETURN_UNDEF;     /* Mutex already unlocked */
+         }
+@@ -1236,7 +1244,7 @@ ithread_join(...)
+             PerlInterpreter *other_perl;
+             CLONE_PARAMS clone_params;
+ 
+-            params_copy = (AV *)SvRV(thread->params);
++            params_copy = thread->params;
+             other_perl = thread->interp;
+             clone_params.stashes = newAV();
+             clone_params.flags = CLONEf_JOIN_IN;
+@@ -1337,6 +1345,7 @@ ithread_kill(...)
+         ithread *thread;
+         char *sig_name;
+         IV signal;
++        int no_handler = 1;
+     CODE:
+         /* Must have safe signals */
+         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) {
+@@ -1366,11 +1375,21 @@ ithread_kill(...)
+         MUTEX_LOCK(&thread->mutex);
+         if (thread->interp) {
+             dTHXa(thread->interp);
+-            PL_psig_pend[signal]++;
+-            PL_sig_pending = 1;
++            if (PL_psig_pend && PL_psig_ptr[signal]) {
++                PL_psig_pend[signal]++;
++                PL_sig_pending = 1;
++                no_handler = 0;
++            }
++        } else {
++            /* Ignore signal to terminated thread */
++            no_handler = 0;
+         }
+         MUTEX_UNLOCK(&thread->mutex);
+ 
++        if (no_handler) {
++            Perl_croak(aTHX_ "Signal %s received in thread %"UVuf", but no signal handler set.", sig_name, thread->tid);
++        }
++
+         /* Return the thread to allow for method chaining */
+         ST(0) = ST(0);
+         /* XSRETURN(1); - implied */
+@@ -1409,6 +1428,7 @@ void
+ ithread_object(...)
+     PREINIT:
+         char *classname;
++        SV *arg;
+         UV tid;
+         ithread *thread;
+         int state;
+@@ -1421,34 +1441,47 @@ ithread_object(...)
+         }
+         classname = (char *)SvPV_nolen(ST(0));
+ 
+-        if ((items < 2) || ! SvOK(ST(1))) {
++        /* Turn $tid from PVLV to SV if needed (bug #73330) */
++        arg = ST(1);
++        SvGETMAGIC(arg);
++
++        if ((items < 2) || ! SvOK(arg)) {
+             XSRETURN_UNDEF;
+         }
+ 
+         /* threads->object($tid) */
+-        tid = SvUV(ST(1));
++        tid = SvUV(arg);
+ 
+-        /* Walk through threads list */
+-        MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
+-        for (thread = MY_POOL.main_thread.next;
+-             thread != &MY_POOL.main_thread;
+-             thread = thread->next)
+-        {
+-            /* Look for TID */
+-            if (thread->tid == tid) {
+-                /* Ignore if detached or joined */
+-                MUTEX_LOCK(&thread->mutex);
+-                state = thread->state;
+-                MUTEX_UNLOCK(&thread->mutex);
+-                if (! (state & PERL_ITHR_UNCALLABLE)) {
+-                    /* Put object on stack */
+-                    ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
+-                    have_obj = 1;
++        /* If current thread wants its own object, then behave the same as
++           ->self() */
++        thread = S_ithread_get(aTHX);
++        if (thread->tid == tid) {
++            ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
++            have_obj = 1;
++
++        } else {
++            /* Walk through threads list */
++            MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
++            for (thread = MY_POOL.main_thread.next;
++                 thread != &MY_POOL.main_thread;
++                 thread = thread->next)
++            {
++                /* Look for TID */
++                if (thread->tid == tid) {
++                    /* Ignore if detached or joined */
++                    MUTEX_LOCK(&thread->mutex);
++                    state = thread->state;
++                    MUTEX_UNLOCK(&thread->mutex);
++                    if (! (state & PERL_ITHR_UNCALLABLE)) {
++                        /* Put object on stack */
++                        ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
++                        have_obj = 1;
++                    }
++                    break;
+                 }
+-                break;
+             }
++            MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
+         }
+-        MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
+ 
+         if (! have_obj) {
+             XSRETURN_UNDEF;
+--- dist/threads/threads.pm.orig	2010-09-06 23:30:32.000000000 +0000
++++ dist/threads/threads.pm
+@@ -5,7 +5,7 @@ use 5.008;
+ use strict;
+ use warnings;
+ 
+-our $VERSION = '1.75';
++our $VERSION = '1.78';
+ my $XS_VERSION = $VERSION;
+ $VERSION = eval $VERSION;
+ 
+@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
+ 
+ =head1 VERSION
+ 
+-This document describes threads version 1.75
++This document describes threads version 1.78
+ 
+ =head1 SYNOPSIS
+ 
+@@ -361,9 +361,10 @@ key) will cause its ID to be used as the
+ =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.
++with the specified thread ID.  If C<$tid> is the value for the current thread,
++then this call works the same as C<-E<gt>self()>.  Otherwise, 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()
+ 
+@@ -902,6 +903,18 @@ other threads are started afterwards.
+ If the above does not work, or is not adequate for your application, then file
+ a bug report on L<http://rt.cpan.org/Public/> against the problematic module.
+ 
++=item Memory consumption
++
++On most systems, frequent and continual creation and destruction of threads
++can lead to ever-increasing growth in the memory footprint of the Perl
++interpreter.  While it is simple to just launch threads and then
++C<-E<gt>join()> or C<-E<gt>detach()> them, for long-lived applications, it is
++better to maintain a pool of threads, and to reuse them for the work needed,
++using L<queues|Thread::Queue> to notify threads of pending work.  The CPAN
++distribution of this module contains a simple example
++(F<examples/pool_reuse.pl>) illustrating the creation, use and monitoring of a
++pool of I<reusable> threads.
++
+ =item Current working directory
+ 
+ On all platforms except MSWin32, the setting for the current working directory
+@@ -975,7 +988,7 @@ involved, you may be able to work around
+ version of the object (e.g., using L<Data::Dumper> or L<Storable>), and then
+ reconstituting it in the joining thread.  If you're using Perl 5.10.0 or
+ later, and if the class supports L<shared objects|threads::shared/"OBJECTS">,
+-you can pass them via L<shared queues| Thread::Queue>.
++you can pass them via L<shared queues|Thread::Queue>.
+ 
+ =item END blocks in threads
+ 
+@@ -992,6 +1005,12 @@ mutexes that are needed to control funct
+ For this reason, the use of C<END> blocks in threads is B<strongly>
+ discouraged.
+ 
++=item Open directory handles
++
++Spawning threads with open directory handles (see
++L<opendir|perlfunc/"opendir DIRHANDLE,EXPR">) will crash the interpreter.
++L<[perl #75154]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=75154>
++
+ =item Perl Bugs and the CPAN Version of L<threads>
+ 
+ Support for threads extends beyond the code in this module (i.e.,
+@@ -1021,7 +1040,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.75/threads.pm>
++L<http://annocpan.org/~JDHEDDEN/threads-1.78/threads.pm>
+ 
+ Source repository:
+ L<http://code.google.com/p/threads-shared/>
+--- /dev/null
++++ dist/threads/t/kill2.t
+--- /dev/null	2010-09-23 21:51:28.000000000 +0200
++++ dist/threads/t/kill2.t	2010-09-23 21:47:56.000000000 +0200
+@@ -0,0 +1,68 @@
++use strict;
++use warnings;
++
++BEGIN {
++    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
++
++    use Config;
++    if (! $Config{'useithreads'}) {
++        skip_all(q/Perl not compiled with 'useithreads'/);
++    }
++}
++
++use ExtUtils::testlib;
++
++use threads;
++
++BEGIN {
++    $| = 1;
++    print("1..3\n");   ### Number of tests that will be run ###
++};
++
++fresh_perl_is(<<'EOI', 'ok', { }, 'No signal handler in thread');
++    use threads;
++    my $test = sub {
++        while(1) { sleep(1) }
++    };
++    my $thr = threads->create($test);
++    threads->yield();
++    $thr->detach();
++    eval {
++        $thr->kill('STOP');
++    };
++    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
++EOI
++
++fresh_perl_is(<<'EOI', 'ok', { }, 'Handler to signal mismatch');
++    use threads;
++    my $test = sub {
++        $SIG{'TERM'} = sub { threads->exit() };
++        while(1) { sleep(1) }
++    };
++    my $thr = threads->create($test);
++    threads->yield();
++    $thr->detach();
++    eval {
++        $thr->kill('STOP');
++    };
++    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
++EOI
++
++fresh_perl_is(<<'EOI', 'ok', { }, 'Handler and signal match');
++    use threads;
++    my $test = sub {
++        $SIG{'STOP'} = sub { threads->exit() };
++        while(1) { sleep(1) }
++    };
++    my $thr = threads->create($test);
++    threads->yield();
++    $thr->detach();
++    eval {
++        $thr->kill('STOP');
++    };
++    print((! $@) ? 'ok' : 'not ok');
++EOI
++
++exit(0);
++
++# EOF