From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 18 May 2002 20:48:03 +0000 (+0000)
Subject: Forgotten from #16685.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab335022e3b25ae19e4e8453fb0b38f2ea09412f;p=p5sagit%2Fp5-mst-13.2.git

Forgotten from #16685.

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

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index 28de99c..3d8c97d 100644
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 $|++;
-print "1..5\n";
+print "1..29\n";
 use strict;
 
 
@@ -18,25 +18,255 @@ use threads;
 
 use threads::shared;
 
-my $lock : shared;
+# We can't use the normal ok() type stuff here, as part of the test is
+# to check that the numbers get printed in the right order. Instead, we
+# set a 'base' number for each part of the test and specify the ok()
+# number as an offset from that base.
 
-sub foo {
-    lock($lock);
-    print "ok 1\n";
-    my $tr2 = threads->create(\&bar);
-    cond_wait($lock);
-    $tr2->join();
-    print "ok 5\n";
+my $Base = 0;
+
+sub ok {
+    my ($offset, $bool, $text) = @_;
+    print "not " unless $bool;
+    print "ok ", $Base + $offset, " - $text\n";
 }
 
-sub bar {
-    print "ok 2\n";
-    lock($lock);
-    print "ok 3\n";
-    cond_signal($lock);
-    print "ok 4\n";
+# test locking
+
+{
+    my $lock : shared;
+    my $tr;
+
+    # test that a subthread can't lock until parent thread has unlocked
+
+    {
+	lock($lock);
+	ok(1,1,"set first lock");
+	$tr = async {
+	    lock($lock);
+	    ok(3,1,"set lock in subthread");
+	};
+	threads->yield;
+	ok(2,1,"still got lock");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # ditto with ref to thread
+
+    {
+	my $lockref = \$lock;
+	lock($lockref);
+	ok(1,1,"set first lockref");
+	$tr = async {
+	    lock($lockref);
+	    ok(3,1,"set lockref in subthread");
+	};
+	threads->yield;
+	ok(2,1,"still got lockref");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # make sure recursive locks unlock at the right place
+    {
+	lock($lock);
+	ok(1,1,"set first recursive lock");
+	lock($lock);
+	threads->yield;
+	{
+	    lock($lock);
+	    threads->yield;
+	}
+	$tr = async {
+	    lock($lock);
+	    ok(3,1,"set recursive lock in subthread");
+	};
+	{
+	    lock($lock);
+	    threads->yield;
+	    {
+		lock($lock);
+		threads->yield;
+		lock($lock);
+		threads->yield;
+	    }
+	}
+	ok(2,1,"still got recursive lock");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # Make sure a lock factory gives out fresh locks each time 
+    # for both attribute and run-time shares
+
+    sub lock_factory1 { my $lock : shared; return \$lock; }
+    sub lock_factory2 { my $lock; share($lock); return \$lock; }
+
+    my (@locks1, @locks2);
+    push @locks1, lock_factory1() for 1..2;
+    push @locks1, lock_factory2() for 1..2;
+    push @locks2, lock_factory1() for 1..2;
+    push @locks2, lock_factory2() for 1..2;
+
+    ok(1,1,"lock factory: locking all locks");
+    lock $locks1[0];
+    lock $locks1[1];
+    lock $locks1[2];
+    lock $locks1[3];
+    ok(2,1,"lock factory: locked all locks");
+    $tr = async {
+	ok(3,1,"lock factory: child: locking all locks");
+	lock $locks2[0];
+	lock $locks2[1];
+	lock $locks2[2];
+	lock $locks2[3];
+	ok(4,1,"lock factory: child: locked all locks");
+    };
+    $tr->join;
+	
+    $Base += 4;
 }
 
-my $tr  = threads->create(\&foo);
-$tr->join();
+# test cond_signal()
+
+{
+    my $lock : shared;
+
+    sub foo {
+	lock($lock);
+	ok(1,1,"cond_signal: created first lock");
+	my $tr2 = threads->create(\&bar);
+	cond_wait($lock);
+	$tr2->join();
+	ok(5,1,"cond_signal: joined");
+    }
+
+    sub bar {
+	ok(2,1,"cond_signal: child before lock");
+	lock($lock);
+	ok(3,1,"cond_signal: child locked");
+	cond_signal($lock);
+	ok(4,1,"cond_signal: signalled");
+    }
+
+    my $tr  = threads->create(\&foo);
+    $tr->join();
+
+    $Base += 5;
+
+    # ditto, but with lockrefs
+
+    my $lockref = \$lock;
+    sub foo2 {
+	lock($lockref);
+	ok(1,1,"cond_signal: ref: created first lock");
+	my $tr2 = threads->create(\&bar2);
+	cond_wait($lockref);
+	$tr2->join();
+	ok(5,1,"cond_signal: ref: joined");
+    }
+
+    sub bar2 {
+	ok(2,1,"cond_signal: ref: child before lock");
+	lock($lockref);
+	ok(3,1,"cond_signal: ref: child locked");
+	cond_signal($lockref);
+	ok(4,1,"cond_signal: ref: signalled");
+    }
+
+    $tr  = threads->create(\&foo2);
+    $tr->join();
+
+    $Base += 5;
+
+}
+
+
+# test cond_broadcast()
+
+{
+    my $counter : shared = 0;
+
+    sub waiter {
+	lock($counter);
+	$counter++;
+	cond_wait($counter);
+	$counter += 10;
+    }
+
+    my $tr1 = threads->new(\&waiter);
+    my $tr2 = threads->new(\&waiter);
+    my $tr3 = threads->new(\&waiter);
+
+    while (1) {
+	lock $counter;
+	# make sure all 3 threads are waiting
+	next unless $counter == 3;
+	cond_broadcast $counter;
+	last;
+    }
+    $tr1->join(); $tr2->join(); $tr3->join();
+    ok(1, $counter == 33, "cond_broadcast: all three threads woken");
+    print "# counter=$counter\n";
+
+    $Base += 1;
+
+    # ditto with refs and shared()
+
+    my $counter2;
+    share($counter2);
+    my $r  = \$counter2;
+
+    sub waiter2 {
+	lock($r);
+	$$r++;
+	cond_wait($r);
+	$$r += 10;
+    }
+
+    $tr1 = threads->new(\&waiter2);
+    $tr2 = threads->new(\&waiter2);
+    $tr3 = threads->new(\&waiter2);
+
+    while (1) {
+	lock($r);
+	# make sure all 3 threads are waiting
+	next unless $$r == 3;
+	cond_broadcast $r;
+	last;
+    }
+    $tr1->join(); $tr2->join(); $tr3->join();
+    ok(1, $$r == 33, "cond_broadcast: ref: all three threads woken");
+    print "# counter=$$r\n";
+
+    $Base += 1;
+
+}
+
+# test warnings;
+
+{
+    my $warncount = 0;
+    local $SIG{__WARN__} = sub { $warncount++ };
+
+    my $lock : shared;
+
+    cond_wait($lock);
+    ok(1, $warncount == 1, 'get warning on cond_wait');
+    cond_broadcast($lock);
+    ok(2, $warncount == 2, 'get warning on cond_wait');
+    no warnings 'threads';
+    cond_wait($lock);
+    ok(3, $warncount == 2, 'get no warning on cond_wait');
+    cond_broadcast($lock);
+    ok(4, $warncount == 2, 'get no warning on cond_wait');
+
+    $Base += 4;
+}
+
+