Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 388b017bdc
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 91 lines (70 sloc) 2.02 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
use v6;
use Test;

plan 7;

# 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

#?pugs skip 'race condition hits about 50% of the time'
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';

my @cache = ();
# STM tests on arrays
#?pugs todo 'unimpl'
ok eval( q{
contend { @cache.push( 42 ) };
} ),'method <contend> for arrays; <push> should be safe';

my %cache = ();
# STM tests on hahses
#?pugs todo 'unimpl'
ok eval( q{
contend { %cache{ 42 } == 1 };
} ),'method <contend> for hashes; insert should be safe';

=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

# vim: ft=perl6
Something went wrong with that request. Please try again.