Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

use contend to avoid race condition

git-svn-id: http://svn.pugscode.org/pugs@19890 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
commit 7aa807208c01713f0162f3ddac6847cd0a524ec1 1 parent a20c69c
buchetc authored
Showing with 85 additions and 26 deletions.
  1. +12 −26 S17-async/async.t
  2. +73 −0 S17-async/contend.t
View
38 S17-async/async.t
@@ -1,14 +1,12 @@
use v6-alpha;
use Test;
+plan 10;
-
-plan 8;
-
+# L<S17/Threads>
# try to stop duration of a simple async call
my $timestamp = time;
-# L<S17/Threads>
async {
ok 1, 'async call started';
};
@@ -20,10 +18,10 @@ my $async_duration = time - $timestamp;
$timestamp = time;
my $thr = async {
- sleep 1;
+ sleep .1;
};
-ok time - $timestamp < $async_duration + .5, "yes, 'Im out of sync!";
+ok time - $timestamp < $async_duration + .05, "yes, 'Im out of sync!";
ok $thr, 'stringify a thread';
@@ -31,30 +29,18 @@ ok int $thr, 'numerify a thread should be the thread id';
isnt int $thr, $*PID, 'childs id is not parents thread id';
-$thr.join;
+ok $thr.join, 'thread now joined and back home';
-# try two async calls to something
+# two async calls should do something important
sub do_something_very_important {
return 1;
}
-async { ok do_something_very_important(),'very important: first try' };
-async { ok do_something_very_important(),'very important: second try' };
-
-# try to construct race condition
-# see Stevens 'UNIX network programming' 23.17
-my $counter = 0;
-sub doit {
- my $val = $counter; sleep .0001; $counter = $val + 1;
-}
-
-loop (my $i = 0; $i < 500; $i++) {
-
- async { doit(); };
- async { doit(); };
-
-}
+my @threads;
+@threads[0] = async { ok do_something_very_important(),'very important things from first thread' };
+@threads[1] = async { ok do_something_very_important(),'very important things from second thread' };
-ok $counter < 1000, 'the race condition strikes back';
-#diag( $counter );
+ok @threads[0].join,'first thread joined';
+ok @threads[1].join,'second thread joined';
+# race condition test moved to L<content.t>
View
73 S17-async/contend.t
@@ -0,0 +1,73 @@
+use v6-alpha;
+use Test;
+
+plan 5;
+
+# simple contend/maybe/defer
+sub atomic_sub {
+ state $state = 1;
+ contend { ++$state };
+ return $state;
+}
+
+ok atomic_sub(), 'contend works';
+is atomic_sub(), 2, 'contend preserves state';
+
+# try to construct race condition
+# see Stevens 'UNIX network programming', 23.17, threads/example01
+my $counter = 0;
+sub doit {
+ my $val;
+ loop (my $i = 0; $i < 500; $i++) {
+ $val = $counter; $counter = $val + 1;
+ }
+ return $counter;
+}
+my @thr = gather {
+ take async { doit(); };
+ take async { doit(); };
+}
+is +@thr, 2, 'one thousand threads';
+
+for @thr { .join(); }; # all threads back
+
+ok $counter < 1000, 'the race condition strikes' or diag($counter);
+
+
+$counter = 0; # new counter because not all threads should be back
+
+# L<S17/Atomic Code blocks>
+# now start making C<sub doit> a atomic function
+sub doit_right {
+ my $val;
+ loop (my $i = 0; $i < 500; $i++) {
+ contend { $val = $counter; $counter = $val + 1; };
+ }
+ return $counter;
+}
+
+# now raising counter using the protected contend block
+my @atomic_thr = gather {
+ take async { doit_right(); };
+ take async { doit_right(); };
+}
+for @atomic_thr { .join(); }; # bring them home
+
+is $counter, 1000, 'now we reach the end';
+
+=begin comment
+
+Copied as a reminder for me from the IRC log.
+
+http://irclog.perlgeek.de/perl6/2008-02-09
+
+01:42
+ TimToady
+ mugwump: mostly we won't be using async {...} or locks, I hope
+
+01:43
+ TimToady
+ most of the threading will be done by gather/take, lazy lists, and ==> operators
+ and most of the (non)-locking will be handled by STM
+
+=end comment
Please sign in to comment.
Something went wrong with that request. Please try again.