Skip to content

Commit

Permalink
fudging supply/promise/channel for parrot
Browse files Browse the repository at this point in the history
  • Loading branch information
@dwarring
dwarring committed Apr 6, 2014
1 parent cc7720a commit 0b5b55b
Show file tree
Hide file tree
Showing 2 changed files with 171 additions and 159 deletions.
270 changes: 139 additions & 131 deletions integration/advent2013-day14.t
View file
Expand Up @@ -4,6 +4,7 @@ plan 10;

# Promises

#?rakudo.parrot skip 'no implementation of promise/channel'
{
my $p1000 = start {
(1..Inf).grep(*.is-prime)[999]
Expand All @@ -27,6 +28,7 @@ my @currency_exchanges = (CurrencyExchange.new( :id<fast>, :delay(1) ),
CurrencyExchange.new( :id<slow>, :delay(7) ), # wont finish in 5 sec
);

#?rakudo.parrot skip 'no implementation of promise/channel'
#?rakudo.moar skip 'Promise.in'
{
my $val = 42;
Expand All @@ -37,6 +39,7 @@ my @currency_exchanges = (CurrencyExchange.new( :id<fast>, :delay(1) ),
is_deeply @quotes, [42, 42*3], 'quotes example';
}

#?rakudo.parrot skip 'no implementation of promise/channel'
{
my $p1000 = start {
(1..Inf).grep(*.is-prime)[999]
Expand All @@ -51,6 +54,7 @@ my @currency_exchanges = (CurrencyExchange.new( :id<fast>, :delay(1) ),
is $pwrite.result, 'p1000.txt', '.then chaining';
}

#?rakudo.parrot skip 'no implementation of promise/channel'
{
# Create the promise.
my $p = Promise.new;
Expand All @@ -64,6 +68,7 @@ my @currency_exchanges = (CurrencyExchange.new( :id<fast>, :delay(1) ),
is $p.status, 'Kept', 'kept promise';
}

#?rakudo.parrot skip 'no implementation of promise/channel'
{
# Create the promise.
my $p = Promise.new;
Expand All @@ -79,145 +84,148 @@ my @currency_exchanges = (CurrencyExchange.new( :id<fast>, :delay(1) ),
# Channels

#?rakudo.moar skip 'combined config example'
#?rakudo.parrot skip 'no implementation of promise/channel'
{
my @files = qw<config1.ini config2.ini>;
my %config = read_all(@files);
is %config<font><size>, '10', 'combined config (font/size)';
is %config<font><style>, 'italic', 'combined config (font/style)';
is %config<font><color>, 'red', 'combined config (font/color)';
is %config<line><style>, 'dashed', 'combined config (line/style)';
}

sub read_all(@files) {
my $read = Channel.new;
my $parsed = Channel.new;
read_worker(@files, $read);
parse_worker($read, $parsed);
my %all_config = await config_combiner($parsed);
$read.close; $parsed.close;
return %all_config;
}

sub read_worker(@files, $dest) {

# simulated slurp()
sub Slurp($name) {
my %files = (
'config1.ini' => q:to"END1",
[font]
size = 10
style = italic
[line]
style = dashed
END1
'config2.ini' => q:to"END2",
[font]
color = red
[line]
height = 0.5
END2
);
return %files{$name}
{
my @files = qw<config1.ini config2.ini>;
my %config = read_all(@files);
is %config<font><size>, '10', 'combined config (font/size)';
is %config<font><style>, 'italic', 'combined config (font/style)';
is %config<font><color>, 'red', 'combined config (font/color)';
is %config<line><style>, 'dashed', 'combined config (line/style)';
}

start {
for @files -> $file {
$dest.send( Slurp($file) );
}
$dest.close();
CATCH { diag 'read_worker failure:' ~ $_; $dest.fail($_) }
sub read_all(@files) {
my $read = Channel.new;
my $parsed = Channel.new;
read_worker(@files, $read);
parse_worker($read, $parsed);
my %all_config = await config_combiner($parsed);
$read.close; $parsed.close;
return %all_config;
}
}

sub parse_worker($source, $dest) {
my grammar INIFile {
token TOP {
^
<entries>
<section>+
$
}

token section {
'[' ~ ']' <key> \n
<entries>
}

token entries {
[
| <entry> \n
| \n
]*
}

rule entry { <key> '=' <value> }

token key { \w+ }
token value { \N+ }

token ws { \h* }
}

my class INIFileActions {
method TOP($/) {
my %result;
%result<_> = $<entries>.ast;
## for $<section> -> $sec {
for @<section> -> $sec {
%result{$sec<key>} = $sec<entries>.ast;
}
make %result;
}

method entries($/) {
my %entries;
## for $<entry> -> $e {
for @<entry> -> $e {
%entries{$e<key>} = ~$e<value>;
}
make %entries;
}
sub read_worker(@files, $dest) {

# simulated slurp()
sub Slurp($name) {
my %files = (
'config1.ini' => q:to"END1",
[font]
size = 10
style = italic
[line]
style = dashed
END1
'config2.ini' => q:to"END2",
[font]
color = red
[line]
height = 0.5
END2
);
return %files{$name}
}

start {
for @files -> $file {
$dest.send( Slurp($file) );
}
$dest.close();
CATCH { diag 'read_worker failure:' ~ $_; $dest.fail($_) }
}
}

start {
loop {
winner $source {
more $source {
if INIFile.parse($_, :actions(INIFileActions)) -> $parsed {
$dest.send($parsed.ast);
}
else {
$dest.fail("Could not parse INI file");
last;
}
}
done $source { last }
}
}
$dest.close();
CATCH { diag 'parse worker failure:' ~ $_; $dest.fail($_) }
sub parse_worker($source, $dest) {
my grammar INIFile {
token TOP {
^
<entries>
<section>+
$
}

token section {
'[' ~ ']' <key> \n
<entries>
}

token entries {
[
| <entry> \n
| \n
]*
}

rule entry { <key> '=' <value> }

token key { \w+ }
token value { \N+ }

token ws { \h* }
}

my class INIFileActions {
method TOP($/) {
my %result;
%result<_> = $<entries>.ast;
## for $<section> -> $sec {
for @<section> -> $sec {
%result{$sec<key>} = $sec<entries>.ast;
}
make %result;
}

method entries($/) {
my %entries;
## for $<entry> -> $e {
for @<entry> -> $e {
%entries{$e<key>} = ~$e<value>;
}
make %entries;
}
}

start {
loop {
winner $source {
more $source {
if INIFile.parse($_, :actions(INIFileActions)) -> $parsed {
$dest.send($parsed.ast);
}
else {
$dest.fail("Could not parse INI file");
last;
}
}
done $source { last }
}
}
$dest.close();
CATCH { diag 'parse worker failure:' ~ $_; $dest.fail($_) }
}
}
}

sub config_combiner($source) {
my $p = Promise.new;
my $v = $p.vow;
start {
my %result;
loop {
winner $source {
more $source {
for %^content.kv -> $sec, %kvs {
for %kvs.kv -> $k, $v {
%result{$sec}{$k} = $v;
}
}
}
done $source { last }
}
}
$v.keep(%result);
CATCH { diag "combiner failure:" ~ $_; $v.break($_) }
sub config_combiner($source) {
my $p = Promise.new;
my $v = $p.vow;
start {
my %result;
loop {
winner $source {
more $source {
for %^content.kv -> $sec, %kvs {
for %kvs.kv -> $k, $v {
%result{$sec}{$k} = $v;
}
}
}
done $source { last }
}
}
$v.keep(%result);
CATCH { diag "combiner failure:" ~ $_; $v.break($_) }
}
return $p;
}
return $p;
}
60 changes: 32 additions & 28 deletions integration/advent2013-day19.t
View file
Expand Up @@ -2,44 +2,48 @@ use v6;
use Test;
plan 20;

my $measurements = Supply.new;
#?rakudo.parrot skip 'no implementation of supply'
{
my $measurements = Supply.new;

my $measured = 0;
sub measure_ok($test) {
++$measured;
pass $test;
}
my $measured = 0;
sub measure_ok($test) {
++$measured;
pass $test;
}

$measurements.tap(-> $value {
measure_ok("Measured: $value");
});
$measurements.tap(-> $value {
measure_ok("Measured: $value");
});

$measurements.more(1.5);
$measurements.more(2.3);
$measurements.more(4.6);
is $measured, 3, 'supply - singular tap';
$measurements.more(1.5);
$measurements.more(2.3);
$measurements.more(4.6);
is $measured, 3, 'supply - singular tap';

$measured = 0;
$measurements.tap(-> $value {
measure_ok "Also measured: $value";
});
$measured = 0;
$measurements.tap(-> $value {
measure_ok "Also measured: $value";
});

$measurements.more(2.8);
$measurements.more(2.8);

is $measured, 2, 'supply dual tap';
is $measured, 2, 'supply dual tap';

$measurements.grep(* > 4).tap(-> $value {
measure_ok "HIGH: $value";
});
$measurements.grep(* > 4).tap(-> $value {
measure_ok "HIGH: $value";
});

$measured = 0;
$measurements.more(1.6);
is $measured, 2, 'supply grep and tap';
$measured = 0;
$measurements.more(1.6);
is $measured, 2, 'supply grep and tap';

$measured = 0;
$measurements.more(4.5);
is $measured, 3, 'supply grep and tap';
$measured = 0;
$measurements.more(4.5);
is $measured, 3, 'supply grep and tap';
}

#?rakudo.parrot skip 'no implementation of supply'
#?rakudo.moar skip 'Supply.interval on moar'
{
my $n_batches = 0;
Expand Down

0 comments on commit 0b5b55b

Please sign in to comment.