add serialization tests for moar

.gitignore

@@ -54,3 +54,5 @@ nqp-runtime.jar
 *.moarvm
 MoarVM
 MANIFEST
+
+/nqp.bat

t/moar/01-continuations.t

@@ -0,0 +1,249 @@
+#! nqp
+
+# continuations.
+
+plan(22);
+
+{
+    # unique objects
+    my $A := "A";
+    my $B := "B";
+
+    my int $run;
+    my $res := nqp::continuationreset(nqp::null(), {
+        $run++;
+        42;
+    });
+
+    ok($run == 1, 'reset runs argument once');
+    ok($res == 42, 'reset passes return value');
+
+    my $ex := '';
+    $run := 0;
+
+    # These tests are problematic.  Currently the continuation bubbles up to the nearest
+    # continuation barrier in invokeMain and dies there, with no chance to catch the
+    # resulting exception
+
+    # try {
+    #     nqp::continuationcontrol(0, nqp::null(), { $run++ });
+    #     CATCH { $ex := $! }
+    # }
+    # ok( $ex ~~ /'no matching'/, 'shift dies with no reset' );
+    # ok( $run == 0, '...without running argument' );
+
+    # $ex := '';
+    # try {
+    #     nqp::continuationreset($A, {
+    #         nqp::continuationcontrol(0, $B, { $run++ });
+    #     });
+    #     CATCH { $ex := $! }
+    # }
+    # ok( $ex ~~ /'no matching'/, 'control dies with mismatched reset' );
+
+    my str $log := '';
+    $log := $log ~ 1;
+    my $savecont;
+    my $shift_returned;
+
+    my $reset_returned := nqp::continuationreset(nqp::null(), {
+        $log := $log ~ 2;
+        $shift_returned := nqp::continuationcontrol(0, nqp::null(), -> $cont {
+            $log := $log ~ 3;
+            $savecont := $cont;
+            10;
+        });
+        $log := $log ~ 4;
+        $shift_returned * 2;
+    });
+    ok( $log eq '123', 'control returns from reset' );
+    ok( $savecont, 'got a continuation' );
+
+    ok( $reset_returned == 10, 'shift argument return value is reset return value' );
+
+    $log := '';
+    $reset_returned := nqp::continuationinvoke($savecont, { $log := $log ~ '5'; 15 });
+    ok( $log eq '54', 'continuation invoke "returns" from control');
+    ok( $shift_returned == 15, 'continuation invoke argument is shift return value' );
+    ok( $reset_returned == 30, 'reset block return value is continuation invoke return value' );
+
+    ok( nqp::continuationinvoke($savecont, {25}) == 50, 'continuation can be used more than once' );
+
+    ok( nqp::continuationreset($A, {
+        nqp::continuationcontrol(0, $A, -> $c { 42 });
+        10;
+    }) == 42, 'control may have a matching argument' );
+
+    ok( nqp::continuationreset($A, {
+        nqp::continuationreset($B, {
+            nqp::continuationcontrol(0, $A, -> $c { 42 });
+            10;
+        });
+        11;
+    }) == 42, 'control may match two levels up' );
+
+    ok( nqp::continuationreset($A, {
+        nqp::continuationreset($B, {
+            nqp::continuationcontrol(0, $B, -> $c { 42 });
+            10;
+        }) * 3;
+    }) == 126, 'control may match one level up' );
+
+    ok( nqp::continuationreset($A, {
+        nqp::continuationreset($B, {
+            nqp::continuationcontrol(0, nqp::null(), -> $c { 42 });
+            10;
+        }) * 3;
+    }) == 126, 'null shift matches innermost level');
+
+    my $cont := nqp::continuationreset($A, {
+        nqp::continuationreset($B, {
+            my $v := nqp::continuationcontrol(0, $A, -> $c { $c });
+            nqp::continuationcontrol(0, $B, -> $c { $v * 2 });
+            14;
+        }) * 3;
+    });
+    ok(nqp::continuationinvoke($cont, {10}) == 60, 'continuations can capture reset frames');
+
+    my $*A := 10;
+    my int $A_in_reset;
+    my int $A_in_control;
+    my int $A_in_invoke;
+    my int $B_in_invoke;
+    $cont := nqp::continuationreset($A, {
+        $A_in_reset := $*A;
+        {
+            my $*A := 30;
+            nqp::continuationcontrol(0, $A, -> $c {
+                $A_in_control := $*A;
+                $c
+            });
+        }
+    });
+    {
+        my $*B := 20;
+        my $*A := 40;
+        nqp::continuationinvoke($cont, { $A_in_invoke := $*A; $B_in_invoke := $*B; });
+    }
+
+    ok($A_in_reset == 10, 'reset sees calling scope');
+    ok($A_in_control == 10, 'control does not see intervening scopes');
+    ok($A_in_invoke == 30, 'invoke sees the continuation body');
+    ok($B_in_invoke == 20, 'invoke also sees the invocation context');
+}
+
+{
+    # should be 3 * 3 * 10 = 90
+    # will infinite loop if the clones are removed
+    my $cont := nqp::continuationreset(nqp::null(), {
+        3 * nqp::continuationcontrol(0, nqp::null(), -> $k { $k });
+    });
+    my $val := nqp::continuationinvoke(nqp::continuationclone($cont),
+        { nqp::continuationinvoke(nqp::continuationclone($cont), { 10 }) });
+
+    ok($val == 90, "restacking cont twice with clones works");
+}
+
+# scheme call/cc example: amby thing, needs to use control, not control0
+{
+    # for proper R5RS semantics, run this once wrapping your main function
+    sub run_main($f) {
+        nqp::continuationreset(nqp::null(), $f);
+    }
+
+    sub callcc($f) {
+        # first get the current continuation
+        nqp::continuationcontrol(1, nqp::null(), -> $dcont {
+            my $scheme_cont := -> $val {
+                # when the scheme continuation is invoked, we need to *replace*
+                # the current continuation with this one
+                nqp::continuationcontrol(1, nqp::null(), -> $c {
+                    nqp::continuationinvoke($dcont, { $val })
+                });
+            };
+            nqp::continuationinvoke($dcont, { $f($scheme_cont) });
+        });
+    }
+
+    my $backtrack_cont := sub ($ig) { nqp::die("Out of options!"); };
+
+    sub amb(*@options) {
+        my $old_back := $backtrack_cont;
+        my $here;
+        callcc(-> $c { $here := $c });
+        while @options {
+            my $next := nqp::shift(@options);
+            $backtrack_cont := $here;
+            return $next;
+        }
+        $old_back(0);
+    }
+
+    # 4-queens
+    my $queens := run_main({
+        sub check($a, $b, $dist) { amb() if $a-$b == $dist || $a-$b == -$dist || $a == $b }
+        my $q1 := amb(1,2,3,4);
+        my $q2 := amb(1,2,3,4);
+        check($q1,$q2,1);
+        my $q3 := amb(1,2,3,4);
+        check($q1,$q3,2);
+        check($q2,$q3,1);
+        my $q4 := amb(1,2,3,4);
+        check($q1,$q4,3);
+        check($q2,$q4,2);
+        check($q3,$q4,1);
+        "$q1$q2$q3$q4";
+    });
+
+    ok($queens eq '2413', 'n-queens callcc example');
+}
+
+# gather/take example
+{
+    my $SENTINEL := [];
+    sub yield($value) {
+        nqp::continuationcontrol(0, nqp::null(), -> $dcont {
+            [$value, { nqp::continuationinvoke($dcont, {0}) }]
+        });
+    }
+
+    sub start_iter($body) {
+        my $state := { $body(); yield($SENTINEL) };
+        -> {
+            my $pkt := nqp::continuationreset(nqp::null(), $state);
+            $state := $pkt[1];
+            $pkt[0];
+        }
+    }
+
+    sub mktree($l,$base) {
+        $l ?? [ mktree($l-1,$base~0), mktree($l-1,$base~1) ] !! $base;
+    }
+
+    sub walktree($tree) {
+        if nqp::istype($tree, NQPArray) {
+            for $tree { walktree($_) }
+        } else {
+            yield($tree);
+        }
+    }
+
+    sub uniter($block) {
+        my $iter := start_iter($block);
+        my $rv;
+        my @list;
+        until ($rv := $iter()) =:= $SENTINEL { nqp::push(@list, $rv); }
+        nqp::join('~',@list);
+    }
+
+
+    ok(uniter({ walktree(mktree(3,'')) }) eq '000~001~010~011~100~101~110~111', 'gather example works');
+
+    sub exntest() {
+        nqp::die("foo");
+        nqp::die("bar");
+        nqp::die("baz");
+        CATCH { yield(nqp::getmessage($!)); nqp::resume($!); }
+    }
+    ok(uniter(&exntest) eq 'foo~bar~baz', 'take from handler works');
+}

tools/build/Makefile-Moar.in

@@ -261,10 +261,10 @@ m-bootstrap-files: $(M_STAGE2_OUTPUT)
 ## testing
 
 m-test: m-all
-	prove -r --exec ".@slash@$(M_RUNNER)" t/nqp t/qregex t/p5regex t/qast t/serialization
+	prove -r --exec ".@slash@$(M_RUNNER)" t/nqp t/qregex t/p5regex t/qast t/moar t/serialization
 
 m-test-loud: m-all
-	prove -r -v --exec ".@slash@$(M_RUNNER)" t/nqp t/qregex t/p5regex t/qast t/serialization
+	prove -r -v --exec ".@slash@$(M_RUNNER)" t/nqp t/qregex t/p5regex t/qast t/moar t/serialization
 
 m-core-test: $(M_RUNNER)
 	prove -r --exec ".@slash@$(M_RUNNER)" t/nqp