threads 1.61

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

Fix 'list/array' context - both keywords are supported

p4raw-id: //depot/perl@30677

7 files changed, 33 insertions, 20 deletions

diff --git a/ext/threads/Changes b/ext/threads/Changes
index a9ba0b3b16..1b3f7fa94a 100755
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,10 @@
 Revision history for Perl extension threads.
 
+1.61 Wed Mar 21 16:09:15 EDT 2007
+	- Fix 'list/array' context - both keywords are supported
+	- Upgraded ppport.h to Devel::PPPort 3.11
+	- Removed embed.t - unreliable
+
 1.59 - Mon Feb  5 16:05:44 EST 2007
 	- POD tweaks per Wolfgang Laun
 
diff --git a/ext/threads/README b/ext/threads/README
index 149247e54b..ac67652275 100755
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.59
+threads version 1.61
 ====================
 
 This module exposes interpreter threads to the Perl level.
diff --git a/ext/threads/t/context.t b/ext/threads/t/context.t
index d23bbd080e..0bdac0c791 100644
--- a/ext/threads/t/context.t
+++ b/ext/threads/t/context.t
@@ -65,7 +65,7 @@ sub foo
     my $wantarray = wantarray();
 
     if ($wantarray) {
-        ok($context eq 'array', 'Array context');
+        ok($context eq 'array', 'Array/list context');
         return ('array');
     } elsif (defined($wantarray)) {
         ok($context eq 'scalar', 'Scalar context');
@@ -108,8 +108,8 @@ sub bar
     my $wantarray = threads->wantarray();
 
     if ($wantarray) {
-        ok($context eq 'array', 'Array context');
-        return ('array');
+        ok($context eq 'list', 'Array/list context');
+        return ('list');
     } elsif (defined($wantarray)) {
         ok($context eq 'scalar', 'Scalar context');
         return 'scalar';
@@ -119,11 +119,11 @@ sub bar
     }
 }
 
-($thr) = threads->create('bar', 'array');
+($thr) = threads->create('bar', 'list');
 my $ctx = $thr->wantarray();
 ok($ctx, 'Implicit array context');
 ($res) = $thr->join();
-ok($res eq 'array', 'Implicit array context');
+ok($res eq 'list', 'Implicit array context');
 
 $thr = threads->create('bar', 'scalar');
 $ctx = $thr->wantarray();
@@ -138,11 +138,11 @@ ok(! defined($ctx), 'Implicit void context');
 $res = $thr->join();
 ok(! defined($res), 'Implicit void context');
 
-$thr = threads->create({'context' => 'array'}, 'bar', 'array');
+$thr = threads->create({'context' => 'list'}, 'bar', 'list');
 $ctx = $thr->wantarray();
 ok($ctx, 'Explicit array context');
 ($res) = $thr->join();
-ok($res eq 'array', 'Explicit array context');
+ok($res eq 'list', 'Explicit array context');
 
 ($thr) = threads->create({'scalar' => 'scalar'}, 'bar', 'scalar');
 $ctx = $thr->wantarray();
diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 7f5e21b4a2..689473bec6 100644
--- a/ext/threads/t/exit.t
+++ b/ext/threads/t/exit.t
@@ -56,7 +56,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.59;' .
+run_perl(prog => 'use threads 1.61;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -104,7 +104,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 1.59 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.61 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -112,7 +112,7 @@ run_perl(prog => 'use threads 1.59 qw(exit thread_only);' .
 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 
 
-my $out = run_perl(prog => 'use threads 1.59;' .
+my $out = run_perl(prog => 'use threads 1.61;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '});' .
@@ -125,7 +125,7 @@ is($?>>8, 99, "exit(status) in thread");
 like($out, '1 finished and unjoined', "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 1.59 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.61 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -139,7 +139,7 @@ is($?>>8, 99, "set_thread_exit_only(0)");
 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 1.59;' .
+run_perl(prog => 'use threads 1.61;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .
diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index 4bc45a80c9..aed1d49016 100644
--- a/ext/threads/t/thread.t
+++ b/ext/threads/t/thread.t
@@ -171,7 +171,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.59;' .
+run_perl(prog => 'use threads 1.61;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index 4f42a08e39..2c9ee4ddd4 100755
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.59_01';
+our $VERSION = '1.61';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -98,7 +98,7 @@ sub exit
     # Class method only
     if (ref($class)) {
         require Carp;
-        Carp::croak("Usage: threads->exit(status)");
+        Carp::croak('Usage: threads->exit(status)');
     }
 
     $class->set_thread_exit_only(1);
@@ -138,7 +138,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.59
+This document describes threads version 1.61
 
 =head1 SYNOPSIS
 
@@ -560,8 +560,10 @@ as the first argument:
 
 In the above, the threads object is returned to the parent thread in scalar
 context, and the thread's entry point function C<foo> will be called in list
-context such that the parent thread can receive a list from the C<-E<gt>join()>
-call.  Similarly, if you need the threads object, but your thread will not be
+(array) context such that the parent thread can receive a list (array) from
+the C<-E<gt>join()> call.  (C<'array'> is synonymous with C<'list'>.)
+
+Similarly, if you need the threads object, but your thread will not be
 returning a value (i.e., I<void> context), you would do the following:
 
     my $thr = threads->create({'context' => 'void'}, \&foo);
@@ -957,7 +959,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.59/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.61/threads.pm>
 
 L<threads::shared>, L<perlthrtut>
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 799be0d93c..aa9376727f 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -896,6 +896,8 @@ ithread_create(...)
                 switch (*str) {
                     case 'a':
                     case 'A':
+                    case 'l':
+                    case 'L':
                         context = G_ARRAY;
                         break;
                     case 's':
@@ -913,6 +915,10 @@ ithread_create(...)
                 if (SvTRUE(*hv_fetch(specs, "array", 5, 0))) {
                     context = G_ARRAY;
                 }
+            } else if (hv_exists(specs, "list", 4)) {
+                if (SvTRUE(*hv_fetch(specs, "list", 4, 0))) {
+                    context = G_ARRAY;
+                }
             } else if (hv_exists(specs, "scalar", 6)) {
                 if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) {
                     context = G_SCALAR;