From: Artur Bergman <sky@nanisky.com>
Date: Sun, 12 May 2002 17:59:41 +0000 (+0000)
Subject: Add emulation layer for Thread/Semaphore and Thread/Queue
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c6f85782f1cd7b0fd0a41187c4ee95878c501d4;p=p5sagit%2Fp5-mst-13.2.git

Add emulation layer for Thread/Semaphore and Thread/Queue

p4raw-id: //depot/perl@16559
---

diff --git a/MANIFEST b/MANIFEST
index 35e3dcb..cab3a2c 100644
--- 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
--- 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
--- 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;