From ae2e557bab6edd35a0a635cf118c85d28ffb782a Mon Sep 17 00:00:00 2001
From: Stefan O'Rear <stefanor@cox.net>
Date: Wed, 15 Sep 2010 15:58:17 -0700
Subject: [PATCH] Implement control operators next, redo, last, return

---
 src/Body.pm           |  2 +-
 src/Niecza/Actions.pm |  2 +-
 test2.pl              | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/src/Body.pm b/src/Body.pm
index 2aa3be31..d15c6a2a 100644
--- a/src/Body.pm
+++ b/src/Body.pm
@@ -156,7 +156,7 @@ use CgOp ();
                     CgOp::sink($self->do->cgop($self)),
                     CgOp::rawsccall('Kernel.Take',
                         CgOp::scopedlex('EMPTY'))));
-        } elsif ($self->returnable) {
+        } elsif ($self->returnable && defined($self->signature)) {
             $self->cgoptree(CgOp::prog(@enter,
                     CgOp::return(CgOp::span("rstart", "rend",
                         $self->do->cgop($self))),
diff --git a/src/Niecza/Actions.pm b/src/Niecza/Actions.pm
index 75a736d5..affc2e90 100644
--- a/src/Niecza/Actions.pm
+++ b/src/Niecza/Actions.pm
@@ -1560,7 +1560,7 @@ sub param_var { my ($cl, $M) = @_;
     }
     my $twigil = $M->{twigil}[0] ? $M->{twigil}[0]->Str : '';
     my $sigil = $M->{sigil}->Str;
-    if ($twigil || ($sigil ne '$' && $sigil ne '@' && $sigil ne '%')) {
+    if ($twigil || ($sigil ne '$' && $sigil ne '@' && $sigil ne '%' && $sigil ne '&')) {
         $M->sorry('Non bare scalar targets NYI');
         return;
     }
diff --git a/test2.pl b/test2.pl
index a82920e2..d0690b5d 100644
--- a/test2.pl
+++ b/test2.pl
@@ -1,4 +1,39 @@
 # vim: ft=perl6
 use Test;
 
+sub flow-ok($fn, $flw, $msg) {
+    my $log = '';
+    $fn(-> $i { $log ~= $i });
+    is $log, $flw, $msg;
+}
+
+# XXX multi dispatch
+sub next {
+    Q:CgOp { (rawsccall Kernel.SearchForHandler (int 1) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub last {
+    Q:CgOp { (rawsccall Kernel.SearchForHandler (int 2) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub redo {
+    Q:CgOp { (rawsccall Kernel.SearchForHandler (int 3) (null Frame) (int -1) (null String) (null Variable)) }
+}
+sub return is rawcall {
+    Q:CgOp { (rawsccall Kernel.SearchForHandler (int 4) (null Frame) (int -1) (null String) (pos 0)) }
+}
+
+flow-ok -> &l { my $i = 0; while $i < 2 { $i++; l(1); next; l(2) } }, '11',
+    "next skips second half of while loop";
+flow-ok -> &l { my $i = 0; while $i < 2 { $i++; l(1); last; l(2) } }, '1',
+    "last skips everything";
+flow-ok -> &l { my $i = 0; while True { l($i++); last if $i == 3 } }, '012',
+    "last can leave inf loop";
+flow-ok -> &l { my $i = 3; while $i == 3 { l($i--); redo if $i } }, '321',
+    "redo reenters loops";
+sub foo { return 2; }
+is foo(), 2, "return values work";
+my $cont = False;
+sub foo3 { return 2; $cont = True; }
+foo3;
+ok !$cont, "return exits function";
+
 done-testing;