threads 1.62

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510705170921g77d87898ye2c081fc0df53a9e@mail.gmail.com>

p4raw-id: //depot/perl@31238

9 files changed, 245 insertions, 221 deletions

diff --git a/ext/threads/Changes b/ext/threads/Changes
index 1b3f7fa94a..86c4138973 100755
--- a/ext/threads/Changes
+++ b/ext/threads/Changes
@@ -1,5 +1,10 @@
 Revision history for Perl extension threads.
 
+1.62 Thu May 17 16:10:49 2007
+	- Fixed :all import option
+	- Fixed problems in test suite
+	- Subversion repository on Google
+
 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
diff --git a/ext/threads/README b/ext/threads/README
index ac67652275..b247d99b64 100755
--- a/ext/threads/README
+++ b/ext/threads/README
@@ -1,4 +1,4 @@
-threads version 1.61
+threads version 1.62
 ====================
 
 This module exposes interpreter threads to the Perl level.
diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t
index 689473bec6..ac147d6fbc 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.61;' .
+run_perl(prog => 'use threads 1.62;' .
                  '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.61 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.62 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.61 qw(exit thread_only);' .
 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 
 
-my $out = run_perl(prog => 'use threads 1.61;' .
+my $out = run_perl(prog => 'use threads 1.62;' .
                            '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.61 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.62 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.61;' .
+run_perl(prog => 'use threads 1.62;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .
diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t
index 44ef1cb942..5e4d3b8808 100644
--- a/ext/threads/t/free.t
+++ b/ext/threads/t/free.t
@@ -27,37 +27,37 @@ BEGIN {
         exit(0);
     }
 
+    require Thread::Queue;
+
     $| = 1;
     print("1..29\n");   ### Number of tests that will be run ###
-};
-
-my $TEST;
-BEGIN {
-    share($TEST);
-    $TEST = 1;
 }
 
-ok(1, 'Loaded');
 
-sub ok {
-    my ($ok, $name) = @_;
+my $q = Thread::Queue->new();
+my $TEST = 1;
 
-    lock($TEST);
-    my $id = $TEST++;
-
-    # You have to do it this way or VMS will get confused.
-    if ($ok) {
-        print("ok $id - $name\n");
-    } else {
-        print("not ok $id - $name\n");
-        printf("# Failed test at line %d\n", (caller)[2]);
+sub ok
+{
+    $q->enqueue(@_);
+
+    while ($q->pending()) {
+        my $ok   = $q->dequeue();
+        my $name = $q->dequeue();
+        my $id   = $TEST++;
+
+        if ($ok) {
+            print("ok $id - $name\n");
+        } else {
+            print("not ok $id - $name\n");
+            printf("# Failed test at line %d\n", (caller)[2]);
+        }
     }
-
-    return ($ok);
 }
 
 
 ### Start of Testing ###
+ok(1, 'Loaded');
 
 # Tests freeing the Perl interperter for each thread
 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
@@ -65,8 +65,10 @@ sub ok {
 my ($COUNT, $STARTED) :shared;
 
 sub threading_1 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
     my $id;
     {
@@ -76,7 +78,7 @@ sub threading_1 {
     }
     if ($STARTED < 5) {
         sleep(1);
-        threads->create('threading_1')->detach();
+        threads->create('threading_1', $q)->detach();
     }
 
     if ($id == 1) {
@@ -94,13 +96,13 @@ sub threading_1 {
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
     $STARTED = 0;
     $COUNT = 0;
-    threads->create('threading_1')->detach();
+    threads->create('threading_1', $q)->detach();
     {
         my $cnt = 0;
         while ($cnt < 5) {
@@ -120,15 +122,17 @@ ok($COUNT == 5, "Done - $COUNT threads");
 
 
 sub threading_2 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
     {
         lock($STARTED);
         $STARTED++;
     }
     if ($STARTED < 5) {
-        threads->create('threading_2')->detach();
+        threads->create('threading_2', $q)->detach();
     }
     threads->yield();
 
@@ -136,13 +140,13 @@ sub threading_2 {
     $COUNT++;
     cond_signal($COUNT);
 
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
     $STARTED = 0;
     $COUNT = 0;
-    threads->create('threading_2')->detach();
+    threads->create('threading_2', $q)->detach();
     threads->create(sub {
         threads->create(sub { })->join();
     })->join();
@@ -164,13 +168,17 @@ ok(1, 'Join');
 
 
 sub threading_3 {
+    my $q = shift;
+
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
     {
         threads->create(sub {
+            my $q = shift;
+
             my $tid = threads->tid();
-            ok($tid, "Thread $tid started");
+            $q->enqueue($tid, "Thread $tid started");
 
             sleep(1);
 
@@ -178,21 +186,21 @@ sub threading_3 {
             $COUNT++;
             cond_signal($COUNT);
 
-            ok($tid, "Thread $tid done");
-        })->detach();
+            $q->enqueue($tid, "Thread $tid done");
+        }, $q)->detach();
     }
 
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
 
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 {
     $COUNT = 0;
     threads->create(sub {
-        threads->create('threading_3')->detach();
+        threads->create('threading_3', $q)->detach();
         {
             lock($COUNT);
             while ($COUNT < 2) {
diff --git a/ext/threads/t/free2.t b/ext/threads/t/free2.t
index cdab3ebe41..48e5c00503 100644
--- a/ext/threads/t/free2.t
+++ b/ext/threads/t/free2.t
@@ -32,37 +32,38 @@ BEGIN {
         exit(0);
     }
 
+    require Thread::Queue;
+
     $| = 1;
     print("1..78\n");   ### Number of tests that will be run ###
-};
-
-my $TEST;
-BEGIN {
-    share($TEST);
-    $TEST = 1;
 }
 
-ok(1, 'Loaded');
 
-sub ok {
-    my ($ok, $name) = @_;
+my $q = Thread::Queue->new();
+my $TEST = 1;
 
-    lock($TEST);
-    my $id = $TEST++;
+sub ok
+{
+    $q->enqueue(@_) if @_;
 
-    # You have to do it this way or VMS will get confused.
-    if ($ok) {
-        print("ok $id - $name\n");
-    } else {
-        print("not ok $id - $name\n");
-        printf("# Failed test at line %d\n", (caller)[2]);
-    }
+    while ($q->pending()) {
+        my $ok   = $q->dequeue();
+        my $name = $q->dequeue();
+        my $id   = $TEST++;
 
-    return ($ok);
+        if ($ok) {
+            print("ok $id - $name\n");
+        } else {
+            print("not ok $id - $name\n");
+            printf("# Failed test at line %d\n", (caller)[2]);
+        }
+    }
 }
 
 
+
 ### Start of Testing ###
+ok(1, 'Loaded');
 
 # Tests freeing the Perl interperter for each thread
 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
@@ -73,9 +74,11 @@ my %READY;
 share(%READY);
 
 # Init a thread
-sub th_start {
+sub th_start
+{
+    my $q = shift;
     my $tid = threads->tid();
-    ok($tid, "Thread $tid started");
+    $q->enqueue($tid, "Thread $tid started");
 
     threads->yield();
 
@@ -86,10 +89,10 @@ sub th_start {
         # Create next thread
         if ($tid < 17) {
             my $next = 'th' . ($tid+1);
-            my $th = threads->create($next);
+            my $th = threads->create($next, $q);
         } else {
             # Last thread signals first
-            th_signal(1);
+            th_signal($q, 1);
         }
 
         # Wait until signalled by another thread
@@ -98,28 +101,31 @@ sub th_start {
         }
         $other = delete($READY{$tid});
     }
-    ok($tid, "Thread $tid received signal from $other");
+    $q->enqueue($tid, "Thread $tid received signal from $other");
     threads->yield();
 }
 
 # Thread terminating
-sub th_done {
+sub th_done
+{
+    my $q = shift;
     my $tid = threads->tid();
 
     lock($COUNT);
     $COUNT++;
     cond_signal($COUNT);
 
-    ok($tid, "Thread $tid done");
+    $q->enqueue($tid, "Thread $tid done");
 }
 
 # Signal another thread to go
 sub th_signal
 {
+    my $q = shift;
     my $other = shift;
     my $tid = threads->tid();
 
-    ok($tid, "Thread $tid signalling $other");
+    $q->enqueue($tid, "Thread $tid signalling $other");
 
     lock(%READY);
     $READY{$other} = $tid;
@@ -128,155 +134,189 @@ sub th_signal
 
 #####
 
-sub th1 {
-    th_start();
+sub th1
+{
+    my $q = shift;
+    th_start($q);
 
     threads->detach();
 
-    th_signal(2);
-    th_signal(6);
-    th_signal(10);
-    th_signal(14);
+    th_signal($q, 2);
+    th_signal($q, 6);
+    th_signal($q, 10);
+    th_signal($q, 14);
 
-    th_done();
+    th_done($q);
 }
 
-sub th2 {
-    th_start();
+sub th2
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(4);
-    th_done();
+    th_signal($q, 4);
+    th_done($q);
 }
 
-sub th6 {
-    th_start();
+sub th6
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(8);
-    th_done();
+    th_signal($q, 8);
+    th_done($q);
 }
 
-sub th10 {
-    th_start();
+sub th10
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(12);
-    th_done();
+    th_signal($q, 12);
+    th_done($q);
 }
 
-sub th14 {
-    th_start();
+sub th14
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(16);
-    th_done();
+    th_signal($q, 16);
+    th_done($q);
 }
 
-sub th4 {
-    th_start();
+sub th4
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(3);
-    th_done();
+    th_signal($q, 3);
+    th_done($q);
 }
 
-sub th8 {
-    th_start();
+sub th8
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(7);
-    th_done();
+    th_signal($q, 7);
+    th_done($q);
 }
 
-sub th12 {
-    th_start();
+sub th12
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(13);
-    th_done();
+    th_signal($q, 13);
+    th_done($q);
 }
 
-sub th16 {
-    th_start();
+sub th16
+{
+    my $q = shift;
+    th_start($q);
     threads->detach();
-    th_signal(17);
-    th_done();
+    th_signal($q, 17);
+    th_done($q);
 }
 
-sub th3 {
+sub th3
+{
+    my $q = shift;
     my $tid = threads->tid();
     my $other = 5;
 
-    th_start();
+    th_start($q);
     threads->detach();
-    th_signal($other);
+    th_signal($q, $other);
     sleep(1);
-    ok(1, "Thread $tid getting return from thread $other");
+    $q->enqueue(1, "Thread $tid getting return from thread $other");
     my $ret = threads->object($other)->join();
-    ok($ret == $other, "Thread $tid saw that thread $other returned $ret");
-    th_done();
+    $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
+    th_done($q);
 }
 
-sub th5 {
-    th_start();
-    th_done();
+sub th5
+{
+    my $q = shift;
+    th_start($q);
+    th_done($q);
     return (threads->tid());
 }
 
 
-sub th7 {
+sub th7
+{
+    my $q = shift;
     my $tid = threads->tid();
     my $other = 9;
 
-    th_start();
+    th_start($q);
     threads->detach();
-    th_signal($other);
-    ok(1, "Thread $tid getting return from thread $other");
+    th_signal($q, $other);
+    $q->enqueue(1, "Thread $tid getting return from thread $other");
     my $ret = threads->object($other)->join();
-    ok($ret == $other, "Thread $tid saw that thread $other returned $ret");
-    th_done();
+    $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
+    th_done($q);
 }
 
-sub th9 {
-    th_start();
+sub th9
+{
+    my $q = shift;
+    th_start($q);
     sleep(1);
-    th_done();
+    th_done($q);
     return (threads->tid());
 }
 
 
-sub th13 {
+sub th13
+{
+    my $q = shift;
     my $tid = threads->tid();
     my $other = 11;
 
-    th_start();
+    th_start($q);
     threads->detach();
-    th_signal($other);
+    th_signal($q, $other);
     sleep(1);
-    ok(1, "Thread $tid getting return from thread $other");
+    $q->enqueue(1, "Thread $tid getting return from thread $other");
     my $ret = threads->object($other)->join();
-    ok($ret == $other, "Thread $tid saw that thread $other returned $ret");
-    th_done();
+    $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
+    th_done($q);
 }
 
-sub th11 {
-    th_start();
-    th_done();
+sub th11
+{
+    my $q = shift;
+    th_start($q);
+    th_done($q);
     return (threads->tid());
 }
 
 
-sub th17 {
+sub th17
+{
+    my $q = shift;
     my $tid = threads->tid();
     my $other = 15;
 
-    th_start();
+    th_start($q);
     threads->detach();
-    th_signal($other);
-    ok(1, "Thread $tid getting return from thread $other");
+    th_signal($q, $other);
+    $q->enqueue(1, "Thread $tid getting return from thread $other");
     my $ret = threads->object($other)->join();
-    ok($ret == $other, "Thread $tid saw that thread $other returned $ret");
-    th_done();
+    $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
+    th_done($q);
 }
 
-sub th15 {
-    th_start();
+sub th15
+{
+    my $q = shift;
+    th_start($q);
     sleep(1);
-    th_done();
+    th_done($q);
     return (threads->tid());
 }
 
@@ -284,11 +324,12 @@ sub th15 {
 TEST_STARTS_HERE:
 {
     $COUNT = 0;
-    threads->create('th1');
+    threads->create('th1', $q);
     {
         lock($COUNT);
         while ($COUNT < 17) {
             cond_wait($COUNT);
+            ok();   # Prints out any intermediate results
         }
     }
     sleep(1);
diff --git a/ext/threads/t/kill.t b/ext/threads/t/kill.t
index 3874db1cdf..a361ee32da 100644
--- a/ext/threads/t/kill.t
+++ b/ext/threads/t/kill.t
@@ -35,63 +35,39 @@ BEGIN {
         print("1..0 # Skip: Not using safe signals\n");
         exit(0);
     }
-}
-
-{
-    package Thread::Semaphore;
-    use threads::shared;
 
-    sub new {
-        my $class = shift;
-        my $val : shared = @_ ? shift : 1;
-        bless \$val, $class;
-    }
+    require Thread::Queue;
+    require Thread::Semaphore;
 
-    sub down {
-        my $s = shift;
-        lock($$s);
-        my $inc = @_ ? shift : 1;
-        cond_wait $$s until $$s >= $inc;
-        $$s -= $inc;
-    }
-
-    sub up {
-        my $s = shift;
-        lock($$s);
-        my $inc = @_ ? shift : 1;
-        ($$s += $inc) > 0 and cond_broadcast $$s;
-    }
-}
-
-BEGIN {
     $| = 1;
-    print("1..19\n");   ### Number of tests that will be run ###
+    print("1..18\n");   ### Number of tests that will be run ###
 };
 
-my $TEST = 1;
-share($TEST);
-
-ok(1, 'Loaded');
-
-sub ok {
-    my ($ok, $name) = @_;
 
-    lock($TEST);
-    my $id = $TEST++;
+my $q = Thread::Queue->new();
+my $TEST = 1;
 
-    # You have to do it this way or VMS will get confused.
-    if ($ok) {
-        print("ok $id - $name\n");
-    } else {
-        print("not ok $id - $name\n");
-        printf("# Failed test at line %d\n", (caller)[2]);
+sub ok
+{
+    $q->enqueue(@_);
+
+    while ($q->pending()) {
+        my $ok   = $q->dequeue();
+        my $name = $q->dequeue();
+        my $id   = $TEST++;
+
+        if ($ok) {
+            print("ok $id - $name\n");
+        } else {
+            print("not ok $id - $name\n");
+            printf("# Failed test at line %d\n", (caller)[2]);
+        }
     }
-
-    return ($ok);
 }
 
 
 ### Start of Testing ###
+ok(1, 'Loaded');
 
 ### Thread cancel ###
 
@@ -99,44 +75,33 @@ sub ok {
 my @errs :shared;
 $SIG{__WARN__} = sub { push(@errs, @_); };
 
-
 sub thr_func {
+    my $q = shift;
+
     # Thread 'cancellation' signal handler
     $SIG{'KILL'} = sub {
-        ok(1, 'Thread received signal');
+        $q->enqueue(1, 'Thread received signal');
         die("Thread killed\n");
     };
 
     # Thread sleeps until signalled
-    ok(1, 'Thread sleeping');
-    {
-        local $SIG{'INT'} = sub {};
-        sleep(5);
-    }
+    $q->enqueue(1, 'Thread sleeping');
+    sleep(1) for (1..10);
     # Should not go past here
-    ok(0, 'Thread terminated normally');
+    $q->enqueue(0, 'Thread terminated normally');
     return ('ERROR');
 }
 
-
 # Create thread
-my $thr = threads->create('thr_func');
+my $thr = threads->create('thr_func', $q);
 ok($thr && $thr->tid() == 2, 'Created thread');
 threads->yield();
 sleep(1);
 
 # Signal thread
-ok($thr->kill('KILL'), 'Signalled thread');
+ok($thr->kill('KILL') == $thr, 'Signalled thread');
 threads->yield();
 
-# Interrupt thread's sleep call
-{
-    # We can't be sure whether the signal itself will get delivered to this
-    # thread or the sleeping thread
-    local $SIG{'INT'} = sub {};
-    ok(kill('INT', $$) || $^O eq 'MSWin32', q/Interrupt thread's sleep call/);
-}
-
 # Cleanup
 my $rc = $thr->join();
 ok(! $rc, 'No thread return value');
@@ -149,21 +114,23 @@ ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
 
 sub thr_func2
 {
+    my $q = shift;
+
     my $sema = shift;
-    ok($sema, 'Thread received semaphore');
+    $q->enqueue($sema, 'Thread received semaphore');
 
     # Set up the signal handler for suspension/resumption
     $SIG{'STOP'} = sub {
-        ok(1, 'Thread suspending');
+        $q->enqueue(1, 'Thread suspending');
         $sema->down();
-        ok(1, 'Thread resuming');
+        $q->enqueue(1, 'Thread resuming');
         $sema->up();
     };
 
     # Set up the signal handler for graceful termination
     my $term = 0;
     $SIG{'TERM'} = sub {
-        ok(1, 'Thread caught termination signal');
+        $q->enqueue(1, 'Thread caught termination signal');
         $term = 1;
     };
 
@@ -172,7 +139,7 @@ sub thr_func2
         sleep(1);
     }
 
-    ok(1, 'Thread done');
+    $q->enqueue(1, 'Thread done');
     return ('OKAY');
 }
 
@@ -182,14 +149,14 @@ my $sema = Thread::Semaphore->new();
 ok($sema, 'Semaphore created');
 
 # Create a thread and send it the semaphore
-$thr = threads->create('thr_func2', $sema);
+$thr = threads->create('thr_func2', $q, $sema);
 ok($thr && $thr->tid() == 3, 'Created thread');
 threads->yield();
 sleep(1);
 
 # Suspend the thread
 $sema->down();
-ok($thr->kill('STOP'), 'Suspended thread');
+ok($thr->kill('STOP') == $thr, 'Suspended thread');
 
 threads->yield();
 sleep(1);
@@ -206,6 +173,6 @@ ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
 $rc = $thr->join();
 ok($rc eq 'OKAY', 'Thread return value');
 
-ok($thr->kill('TERM'), 'Ignore signal to terminated thread');
+ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');
 
 # EOF
diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t
index aed1d49016..6c00578a92 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.61;' .
+run_perl(prog => 'use threads 1.62;' .
                  '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 2c9ee4ddd4..2f6363617e 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.61';
+our $VERSION = '1.62';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -62,7 +62,7 @@ sub import
         } elsif ($sym =~ /^str/i) {
             import overload ('""' => \&tid);
 
-        } elsif ($sym =~ /^(?:all|yield)$/) {
+        } elsif ($sym =~ /^(?::all|yield)$/) {
             push(@EXPORT, qw(yield));
 
         } else {
@@ -138,7 +138,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.61
+This document describes threads version 1.62
 
 =head1 SYNOPSIS
 
@@ -959,7 +959,10 @@ 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.61/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.62/threads.pm>
+
+Source repository:
+L<http://code.google.com/p/threads-shared/>
 
 L<threads::shared>, L<perlthrtut>
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index aa9376727f..f43b4280f7 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -848,7 +848,7 @@ ithread_create(...)
     CODE:
         if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) {
             if (--items < 2) {
-                Perl_croak(aTHX_ "Usage: threads->create(\\%specs, function, ...)");
+                Perl_croak(aTHX_ "Usage: threads->create(\\%%specs, function, ...)");
             }
             specs = (HV*)SvRV(ST(1));
             idx = 1;