Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 74 lines (56 sloc) 1.621 kb
7aa80720 »
2008-02-11 use contend to avoid race condition
1 use v6-alpha;
2 use Test;
3
4 plan 5;
5
6 # simple contend/maybe/defer
7 sub atomic_sub {
8 state $state = 1;
9 contend { ++$state };
10 return $state;
11 }
12
13 ok atomic_sub(), 'contend works';
14 is atomic_sub(), 2, 'contend preserves state';
15
16 # try to construct race condition
17 # see Stevens 'UNIX network programming', 23.17, threads/example01
18 my $counter = 0;
19 sub doit {
20 my $val;
21 loop (my $i = 0; $i < 500; $i++) {
22 $val = $counter; $counter = $val + 1;
23 }
24 return $counter;
25 }
26 my @thr = gather {
27 take async { doit(); };
28 take async { doit(); };
29 }
30 is +@thr, 2, 'one thousand threads';
31
32 for @thr { .join(); }; # all threads back
33
34 ok $counter < 1000, 'the race condition strikes' or diag($counter);
35
36
37 $counter = 0; # new counter because not all threads should be back
38
39 # L<S17/Atomic Code blocks>
40 # now start making C<sub doit> a atomic function
41 sub doit_right {
42 my $val;
43 loop (my $i = 0; $i < 500; $i++) {
44 contend { $val = $counter; $counter = $val + 1; };
45 }
46 return $counter;
47 }
48
49 # now raising counter using the protected contend block
50 my @atomic_thr = gather {
51 take async { doit_right(); };
52 take async { doit_right(); };
53 }
54 for @atomic_thr { .join(); }; # bring them home
55
56 is $counter, 1000, 'now we reach the end';
57
58 =begin comment
59
60 Copied as a reminder for me from the IRC log.
61
62 http://irclog.perlgeek.de/perl6/2008-02-09
63
64 01:42
65 TimToady
66 mugwump: mostly we won't be using async {...} or locks, I hope
67
68 01:43
69 TimToady
70 most of the threading will be done by gather/take, lazy lists, and ==> operators
71 and most of the (non)-locking will be handled by STM
72
73 =end comment
Something went wrong with that request. Please try again.