From da140a4068f95cc339e9327c1579a94f9f241dd8 Mon Sep 17 00:00:00 2001 From: "Jerry D. Hedden" Date: Wed, 21 Mar 2007 06:15:53 -0700 Subject: [PATCH] threads 1.61 From: "Jerry D. Hedden" Message-ID: <999680.51877.qm@web30208.mail.mud.yahoo.com> Fix 'list/array' context - both keywords are supported p4raw-id: //depot/perl@30677 --- ext/threads/Changes | 5 +++++ ext/threads/README | 2 +- ext/threads/t/context.t | 14 +++++++------- ext/threads/t/exit.t | 10 +++++----- ext/threads/t/thread.t | 2 +- ext/threads/threads.pm | 14 ++++++++------ ext/threads/threads.xs | 6 ++++++ 7 files changed, 33 insertions(+), 20 deletions(-) diff --git a/ext/threads/Changes b/ext/threads/Changes index a9ba0b3..1b3f7fa 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 149247e..ac67652 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 d23bbd0..0bdac0c 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 7f5e21b..689473b 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 4bc45a8..aed1d49 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 4f42a08..2c9ee4d 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 will be called in list -context such that the parent thread can receive a list from the C<-Ejoin()> -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<-Ejoin()> 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 context), you would do the following: my $thr = threads->create({'context' => 'void'}, \&foo); @@ -957,7 +959,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 799be0d..aa93767 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; -- 2.7.4