Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add serialization tests for moar

  • Loading branch information...
commit e264d33d3d73da35da91b2281865268dc5cc9c65 1 parent d4da7fb
@diakopter diakopter authored
View
2  .gitignore
@@ -54,3 +54,5 @@ nqp-runtime.jar
*.moarvm
MoarVM
MANIFEST
+
+/nqp.bat
View
249 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');
+}
View
4 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
Please sign in to comment.
Something went wrong with that request. Please try again.