Add emulation layer for Thread/Semaphore and Thread/Queue

p4raw-id: //depot/perl@16559

diff --git a/MANIFEST b/MANIFEST
index 35e3dcb..cab3a2c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -646,8 +646,6 @@ ext/Thread/sync.tx          Test thread synchronisation
 ext/Thread/sync2.tx            Test thread synchronisation
 ext/Thread/thr5005.t           Test 5.005-style threading (skipped if no use5005threads)
 ext/Thread/Thread.xs           Thread extension external subroutines
-ext/Thread/Thread/Queue.pm     Thread synchronised queue objects
-ext/Thread/Thread/Semaphore.pm Thread semaphore objects
 ext/Thread/Thread/Signal.pm    Start a thread to run signal handlers
 ext/Thread/Thread/Specific.pm  Thread specific data access
 ext/Thread/typemap             Thread extension interface types
@@ -1500,6 +1498,8 @@ lib/Text/TabsWrap/t/tabs.t        See if Text::Tabs works
 lib/Text/TabsWrap/t/wrap.t     See if Text::Wrap::wrap works
 lib/Text/Wrap.pm               Paragraph formatter
 lib/Thread.pm                  Thread extensions frontend
+lib/Thread/Queue.pm            Thread synchronised queue objects
+lib/Thread/Semaphore.pm                Thread semaphore objects
 lib/Tie/Array.pm               Base class for tied arrays
 lib/Tie/Array/push.t           Test for Tie::Array
 lib/Tie/Array/splice.t         Test for Tie::Array::SPLICE

diff --git a/ext/Thread/Thread/Queue.pm b/lib/Thread/Queue.pm
similarity index 75%
rename from ext/Thread/Thread/Queue.pm
rename to lib/Thread/Queue.pm
index 272a2a3..5285468 100644 (file)
--- a/ext/Thread/Thread/Queue.pm
+++ b/lib/Thread/Queue.pm
@@ -2,8 +2,30 @@ package Thread::Queue;
 
 our $VERSION = '1.00';
 
+our $ithreads;
+our $othreads;
+
 use Thread qw(cond_wait cond_broadcast);
 
+BEGIN {
+    use Config;
+    $ithreads = $Config{useithreads};
+    $othreads = $Config{use5005threads};
+    if($ithreads) {
+       require 'threads/shared/queue.pm';
+       for my $m (qw(new enqueue dequeue dequeue_nb pending)) {
+           no strict 'refs';
+           *{"Thread::Queue::$m"} = \&{"threads::shared::queue::${m}"};
+       }
+    } else {
+       for my $m (qw(new enqueue dequeue dequeue_nb pending)) {
+           no strict 'refs';
+           *{"Thread::Queue::$m"} = \&{"Thread::Queue::${m}_othread"};
+       }
+    }
+}
+
+
 =head1 NAME
 
 Thread::Queue - thread-safe queues
@@ -65,18 +87,18 @@ L<Thread>
 
 =cut
 
-sub new {
+sub new_othread {
     my $class = shift;
     return bless [@_], $class;
 }
 
-sub dequeue : locked : method {
+sub dequeue_othread : locked : method {
     my $q = shift;
     cond_wait $q until @$q;
     return shift @$q;
 }
 
-sub dequeue_nb : locked : method {
+sub dequeue_nb_othread : locked : method {
   my $q = shift;
   if (@$q) {
     return shift @$q;
@@ -85,12 +107,12 @@ sub dequeue_nb : locked : method {
   }
 }
 
-sub enqueue : locked : method {
+sub enqueue_othread : locked : method {
     my $q = shift;
     push(@$q, @_) and cond_broadcast $q;
 }
 
-sub pending : locked : method {
+sub pending_othread : locked : method {
   my $q = shift;
   return scalar(@$q);
 }

diff --git a/ext/Thread/Thread/Semaphore.pm b/lib/Thread/Semaphore.pm
similarity index 80%
rename from ext/Thread/Thread/Semaphore.pm
rename to lib/Thread/Semaphore.pm
index 2a8ec25..66e8878 100644 (file)
--- a/ext/Thread/Thread/Semaphore.pm
+++ b/lib/Thread/Semaphore.pm
@@ -3,6 +3,25 @@ use Thread qw(cond_wait cond_broadcast);
 
 our $VERSION = '1.00';
 
+BEGIN {
+    use Config;
+    $ithreads = $Config{useithreads};
+    $othreads = $Config{use5005threads};
+    if($ithreads) {
+       require 'threads/shared/semaphore.pm';
+       for my $m (qw(new up down)) {
+           no strict 'refs';
+           *{"Thread::Semaphore::$m"} = \&{"threads::shared::semaphore::${m}"};
+       }
+    } else {
+       for my $m (qw(new up down)) {
+           no strict 'refs';
+           *{"Thread::Semaphore::$m"} = \&{"Thread::Semaphore::${m}_othread"};
+       }
+    }
+}
+
+
 =head1 NAME
 
 Thread::Semaphore - thread-safe semaphores
@@ -65,20 +84,20 @@ above what the C<down>s are trying to decrement it by.
 
 =cut
 
-sub new {
+sub new_othread {
     my $class = shift;
     my $val = @_ ? shift : 1;
     bless \$val, $class;
 }
 
-sub down : locked : method {
+sub down_othread : locked : method {
     my $s = shift;
     my $inc = @_ ? shift : 1;
     cond_wait $s until $$s >= $inc;
     $$s -= $inc;
 }
 
-sub up : locked : method {
+sub up_othread : locked : method {
     my $s = shift;
     my $inc = @_ ? shift : 1;
     ($$s += $inc) > 0 and cond_broadcast $s;