Coro/t/15_semaphore.t

$|=1;
print "1..6\n";

use Coro;
use Coro::Semaphore;

{
   my $sem = new Coro::Semaphore 2;

   my $rand = 0;

   sub xrand {
      $rand = ($rand * 121 + 2121) % 212121;
      $rand / 212120
   }

   my $counter;

   $_->join for
      map {
         async {
            my $current = $Coro::current;
            for (1..100) {
               cede if 0.2 > xrand;
               Coro::async_pool { $current->ready } if 0.2 > xrand;
               $counter += $sem->count;
               my $guard = $sem->guard;
               cede; cede; cede; cede;
            }
         }
      } 1..15
   ;

   print $counter == 998 ? "" : "not ", "ok 1 # $counter\n";
}

# check terminate
{
   my $sem = new Coro::Semaphore 0;

   $as1 = async {
      my $g = $sem->guard;
      print "not ok 2\n";
   };    

   $as2 = async {
      my $g = $sem->guard;
      print "ok 2\n";
   };    

   cede;

   $sem->up; # wake up as1
   $as1->cancel; # destroy as1 before it could ->guard
   $as1->join;
   $as2->join;
}

# check throw
{
   my $sem = new Coro::Semaphore 0;

   $as1 = async {
      my $g = eval {
         $sem->guard;
      };
      print $@ ? "" : "not ", "ok 3\n";
   };    

   $as2 = async {
      my $g = $sem->guard;
      print "ok 4\n";
   };    

   cede;

   $sem->up; # wake up as1
   $as1->throw (1); # destroy as1 before it could ->guard
   $as1->join;
   $as2->join;
}

# check wait
{
   my $sem = new Coro::Semaphore 0;

   $as1 = async {
      $sem->wait;
      print "ok 5\n";
   };    

   $as2 = async {
      my $g = $sem->guard;
      print "ok 6\n";
   };    

   cede;

   $sem->up; # wake up as1
   $as1->join;
   $as2->join;
}


Revision:	1.4
Committed:	Tue Nov 18 23:20:41 2008 UTC (15 years, 6 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-6_09, rel-5_131, rel-6_0, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-5_162, rel-5_2, rel-6_10, rel-6_13, rel-6_03, rel-6_02, rel-5_151, rel-5_22, rel-5_11, rel-5_12, rel-5_15, rel-5_14, rel-5_17, rel-5_16, rel-5_37, rel-5_36, rel-6_23, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_29, rel-6_28, rel-6_01, rel-5_132, rel-5_0, rel-5_371, rel-5_372, rel-5_1, rel-5_161
Changes since 1.3:	+47 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	$\|=1;
2	root	1.4	print "1..6\n";
3	root	1.1
4			use Coro;
5			use Coro::Semaphore;
6
7	root	1.3	{
8			my $sem = new Coro::Semaphore 2;
9	root	1.1
10	root	1.3	my $rand = 0;
11	root	1.1
12	root	1.3	sub xrand {
13			$rand = ($rand * 121 + 2121) % 212121;
14			$rand / 212120
15			}
16
17			my $counter;
18
19			$_->join for
20			map {
21			async {
22			my $current = $Coro::current;
23			for (1..100) {
24			cede if 0.2 > xrand;
25			Coro::async_pool { $current->ready } if 0.2 > xrand;
26			$counter += $sem->count;
27			my $guard = $sem->guard;
28			cede; cede; cede; cede;
29			}
30	root	1.1	}
31	root	1.3	} 1..15
32			;
33	root	1.1
34	root	1.3	print $counter == 998 ? "" : "not ", "ok 1 # $counter\n";
35			}
36	root	1.2
37	root	1.4	# check terminate
38	root	1.2	{
39			my $sem = new Coro::Semaphore 0;
40
41			$as1 = async {
42			my $g = $sem->guard;
43			print "not ok 2\n";
44			};
45
46			$as2 = async {
47			my $g = $sem->guard;
48			print "ok 2\n";
49			};
50
51			cede;
52
53			$sem->up; # wake up as1
54			$as1->cancel; # destroy as1 before it could ->guard
55			$as1->join;
56			$as2->join;
57			}
58
59	root	1.4	# check throw
60			{
61			my $sem = new Coro::Semaphore 0;
62
63			$as1 = async {
64			my $g = eval {
65			$sem->guard;
66			};
67			print $@ ? "" : "not ", "ok 3\n";
68			};
69
70			$as2 = async {
71			my $g = $sem->guard;
72			print "ok 4\n";
73			};
74
75			cede;
76
77			$sem->up; # wake up as1
78			$as1->throw (1); # destroy as1 before it could ->guard
79			$as1->join;
80			$as2->join;
81			}
82
83			# check wait
84			{
85			my $sem = new Coro::Semaphore 0;
86
87			$as1 = async {
88			$sem->wait;
89			print "ok 5\n";
90			};
91
92			$as2 = async {
93			my $g = $sem->guard;
94			print "ok 6\n";
95			};
96
97			cede;
98
99			$sem->up; # wake up as1
100			$as1->join;
101			$as2->join;
102			}
103
104	root	1.1