fixes for wait $n and winner *

rakudo · Nov 21, 2013 · 528c078 · 528c078
1 parent 38f32bb
commit 528c078
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 9 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -1229,11 +1229,19 @@ class Perl6::Actions is HLL::Actions does STDActions {
         my @inner_statements := $<xblock><pblock><blockoid><statementlist><statement>;
         my $wild_done;
         my $wild_more;
-        my $later;
+        my $wait;
+        my $wait_time;
 
         my $past := QAST::Op.new( :op('call'), :name('&WINNER'), :node($/) );
         if $<xblock> {
-            $past.push( $<xblock><EXPR>.ast );
+            if nqp::istype($<xblock><EXPR>.ast.returns, $*W.find_symbol(['Whatever'])) {
+                $past.push( QAST::Op.new(
+                        :op('callmethod'),
+                        :name('new'),
+                        QAST::WVal.new( :value($*W.find_symbol(['List'])) ) ));
+            } else {
+                $past.push( $<xblock><EXPR>.ast );
+            }
         } elsif $<block> {
             $past.push( QAST::Op.new(
                     :op('callmethod'),
@@ -1267,16 +1275,18 @@ class Perl6::Actions is HLL::Actions does STDActions {
                     }
                 } elsif $<sym> eq 'wait' {
                     # TODO error
-                    $later := block_closure($<block>.ast);
-                    $later.named('wait');
+                    $wait_time:= $<xblock><EXPR>.ast;
+                    $wait_time.named('wait_time');
+                    $wait := block_closure($<xblock><pblock>.ast);
+                    $wait.named('wait');
                 }
             } else {
                 # TODO error
             }
         }
         if $wild_done { $past.push( $wild_done ) }
         if $wild_more { $past.push( $wild_more ) }
-        if $later     { $past.push( $later ) }
+        if $wait      { $past.push( $wait ); $past.push( $wait_time ) }
 
         make $past;
     }

diff --git a/src/vm/jvm/core/asyncops.pm b/src/vm/jvm/core/asyncops.pm
@@ -17,8 +17,10 @@ multi sub await(Channel $c) {
 my constant $WINNER_KIND_DONE = 0;
 my constant $WINNER_KIND_MORE = 1;
 
-sub WINNER(@winner_args, *@pieces, :$wild_done, :$wild_more, :$wait) {
+sub WINNER(@winner_args, *@pieces, :$wild_done, :$wild_more, :$wait, :$wait_time is copy) {
+    my num $start_time = nqp::time_n();
     my Int $num_pieces = +@pieces div 3;
+    my $timeout_promise;
     sub invoke_right(&block, $key, $value?) {
         my @names = map *.name, &block.signature.params;
         return do if @names eqv ['$k', '$v'] || @names eqv ['$v', '$k'] {
@@ -71,7 +73,17 @@ sub WINNER(@winner_args, *@pieces, :$wild_done, :$wild_more, :$wait) {
                 }
             }
             if $wait {
-                return $wait();
+                $wait_time -= (nqp::time_n() - $start_time);
+                if $wait_time <= 0 || $timeout_promise {
+                    return $wait();
+                } elsif !$timeout_promise {
+                    $timeout_promise = Promise.in($wait_time);
+                    @promises_only.push: $timeout_promise;
+                    $num_pieces++;
+                    @pieces.push: 0;
+                    @pieces.push: $timeout_promise;
+                    @pieces.push: $wait;
+                }
             }
         } else {
             for @winner_args.pick(*) {
@@ -84,7 +96,9 @@ sub WINNER(@winner_args, *@pieces, :$wild_done, :$wild_more, :$wait) {
                     $has_channels = True;
                 }
                 when Promise {
-                    if $_ {
+                    if $_ eqv $timeout_promise && $_ {
+                        return $wait();
+                    } elsif $_ {
                         return invoke_right($wild_done, $_, $_.result);
                     }
                     @promises_only.push: $_;
@@ -98,7 +112,15 @@ sub WINNER(@winner_args, *@pieces, :$wild_done, :$wild_more, :$wait) {
             # we immediately return, otherwise we block on any
             # of the promises of our args.
             if $wait {
-                return $wait();
+                $wait_time -= (nqp::time_n() - $start_time);
+                if $wait_time <= 0 || $timeout_promise {
+                    return $wait();
+                } elsif !$timeout_promise {
+                    $timeout_promise = Promise.in($wait_time);
+                    @promises_only.push: $timeout_promise;
+                    $num_pieces++;
+                    @winner_args.push: $timeout_promise;
+                }
             }
             # if we only had promises, we can block on "anyof".
         }