Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

chase rakudo CALLER:: semantics.

  • Loading branch information...
commit 8c8f50d307c5325d8e4c4c89c3ab031009f4cc02 1 parent 25a573e
@timo timo authored
Showing with 45 additions and 45 deletions.
  1. +11 −11 lib/Test/Ix.pm
  2. +34 −34 t/01-game-rules.t
View
22 lib/Test/Ix.pm
@@ -14,9 +14,9 @@ sub inject-subs-in-file($file) {
my @tests = find-all-tests-in-declaration($declaration);
for @tests -> $test {
my $subname = $test.subst(' ', '-', :global);
- next if $code ~~ /'sub ' $subname/; # already in there
+ next if $code ~~ /'my &*' $subname/; # already in there
my $sub =
- sprintf (join "\n", 'sub %s {', ' ok 0, "%s";', '}', ''),
+ sprintf (join "\n", 'my &*%s = sub {', ' ok 0, "%s";', '}', ''),
$subname, $test;
$code = inject $sub, :into($code);
}
@@ -89,17 +89,17 @@ sub run-tests(@tests) is export {
my \PKG := CALLER::;
my &runtest = {
my $subname = $_.subst(' ', '-', :global);
- my $sub = PKG{'&'~$subname};
- if $sub ~~ Nil {
+ my $sub = PKG{'&*'~$subname};
+ if $sub ~~ :!defined {
ok 0, sprintf 'tried to run %s but it did not exist', $subname;
- return;
+ } else {
+ my @arguments = PKG{'&*before'} ~~ Sub # is there a &before sub?
+ ?? PKG{'&*before'}().list[ 0 ..^ $sub.arity ]
+ !! Any xx $sub.arity;
+ $sub(|@arguments);
+ PKG{'&*after'} ~~ Sub
+ and PKG{'&*after'}();
}
- my @arguments = PKG{'&before'} ~~ Sub # is there a &before sub?
- ?? PKG{'&before'}().list[ 0 ..^ $sub.arity ]
- !! Any xx $sub.arity;
- $sub(|@arguments);
- PKG{'&after'} ~~ Sub
- and PKG{'&after'}();
};
traverse-tests(@tests, &runtest);
}
View
68 t/01-game-rules.t
@@ -51,10 +51,7 @@ my @tests =
]
;
-plan count-tests(@tests);
-run-tests(@tests);
-
-our sub before {
+my &*before = sub {
my Druid::Game $game .= new(:size(3));
# XXX: Maybe we should mock these instead of depending on Druid::Player.
my Druid::Player ($player1, $player2)
@@ -63,18 +60,18 @@ our sub before {
return ($game, $player1, $player2);
}
-our sub the-player-to-move-is-vertical-at-the-beginning-of-the-game {
+my &*the-player-to-move-is-vertical-at-the-beginning-of-the-game = sub {
is $^game.player-to-move, 1,
"the player to move is vertical at the beginning of the game";
}
-our sub the-player-to-move-is-horizontal-after-the-first-move {
+my &*the-player-to-move-is-horizontal-after-the-first-move = sub {
$^game.make-move('a1');
is $game.player-to-move, 2,
"the player to move is horizontal after the first move";
}
-our sub the-player-to-move-alternates-with-every-move {
+my &*the-player-to-move-alternates-with-every-move = sub {
$^game; # must mention it outside of the gather
my @move-order = gather for ^10 {
take 0+$game.player-to-move;
@@ -86,113 +83,113 @@ our sub the-player-to-move-alternates-with-every-move {
"the player to move alternates with every move";
}
-our sub a-sarsen-move-must-have-a-certain-syntax {
+my &*a-sarsen-move-must-have-a-certain-syntax = sub {
ok (!defined $^game.make-move("1a")),
"a sarsen move must have a certain syntax";
}
-our sub a-sarsen-move-must-be-within-the-limits-of-the-board {
+my &*a-sarsen-move-must-be-within-the-limits-of-the-board = sub {
ok (!defined $^game.make-move("a5")),
"a sarsen move must be within the limits of the board";
}
-our sub a-sarsen-move-can-be-made-directly-on-the-ground {
+my &*a-sarsen-move-can-be-made-directly-on-the-ground = sub {
ok (defined $^game.make-move("b2")),
"a sarsen move can be made directly on the ground";
}
-our sub a-sarsen-move-can-be-made-on-top-of-the-same-color {
+my &*a-sarsen-move-can-be-made-on-top-of-the-same-color = sub {
$^game.make-move($_) for <b2 a1>;
ok (defined $game.make-move("b2")),
"a sarsen move can be made on top of the same color";
}
-our sub a-sarsen-move-can-not-be-made-on-top-of-another-color {
+my &*a-sarsen-move-can-not-be-made-on-top-of-another-color = sub {
$^game.make-move($_) for <b2 a1>;
ok (!defined $game.make-move("a1")),
"a sarsen move can not be made on top of another color";
}
-our sub a-lintel-move-must-have-a-certain-syntax {
+my &*a-lintel-move-must-have-a-certain-syntax = sub {
ok (!defined $^game.make-move("a3-3c")),
"a lintel move must have a certain syntax";
}
-our sub a-lintel-move-must-be-within-the-limits-of-the-board {
+my &*a-lintel-move-must-be-within-the-limits-of-the-board = sub {
ok (!defined $^game.make-move("a4-c4")),
"a lintel move must be within the limits of the board";
}
-our sub a-lintel-move-can-not-be-made-directly-on-the-ground {
+my &*a-lintel-move-can-not-be-made-directly-on-the-ground = sub {
ok (!defined $^game.make-move("a1-c1")),
"a lintel move can not be made directly on the ground";
}
-our sub a-lintel-move-must-be-made-two-units-apart {
+my &*a-lintel-move-must-be-made-two-units-apart = sub {
$^game.make-move($_) for <a1 a3 b1>;
ok (!defined $game.make-move("a1-b1")),
"a lintel move must be made two units apart";
}
-our sub a-lintel-move-must-have-support-at-both-ends {
+my &*a-lintel-move-must-have-support-at-both-ends = sub {
$^game.make-move($_) for <a1 a3>;
ok (!defined $game.make-move("a1-c1")),
"a lintel move must have support at both ends";
}
-our sub a-lintel-move-can-not-have-less-than-two-friendly-stones-under-it {
+my &*a-lintel-move-can-not-have-less-than-two-friendly-stones-under-it = sub {
$^game.make-move($_) for <a1 b1 a3 c1>;
ok (!defined $game.make-move('a1-c1')),
"a lintel move can not have less than two friendly stones under it";
}
-our sub a-lintel-move-can-not-have-more-than-two-friendly-stones-under-it {
+my &*a-lintel-move-can-not-have-more-than-two-friendly-stones-under-it = sub {
$^game.make-move($_) for <a1 a3 b1 b3 c1 c3>;
ok (!defined $game.make-move('a1-c1')),
"a lintel move can not have more than two friendly stones under it";
}
-our sub a-lintel-move-can-form-a-bridge {
+my &*a-lintel-move-can-form-a-bridge = sub {
$^game.make-move($_) for <a2 a1 c2 c1>;
ok (defined $game.make-move('a2-c2')), "a lintel move can form a bridge";
}
-our sub a-lintel-move-can-claim-enemy-territory {
+my &*a-lintel-move-can-claim-enemy-territory = sub {
$^game.make-move($_) for <a1 a3 b1 c1>;
ok (defined $game.make-move('a1-c1')),
"a lintel move can claim enemy territory";
}
-our sub swapping-is-allowed-as-the-second-move {
+my &*swapping-is-allowed-as-the-second-move = sub {
$^game.make-move('a1');
ok (defined $game.make-move('swap')),
"swapping is allowed as the second move";
}
-our sub swapping-is-not-allowed-as-the-first-move {
+my &*swapping-is-not-allowed-as-the-first-move = sub {
ok (!defined $^game.make-move('swap')),
"swapping is not allowed as the first move";
}
-our sub swapping-is-not-allowed-after-the-second-move {
+my &*swapping-is-not-allowed-after-the-second-move = sub {
$^game.make-move($_) for <a1 a2>;
ok (!defined $^game.make-move('swap')),
"swapping is not allowed after the second move";
}
-our sub swapping-exchanges-the-colors-of-the-players {
+my &*swapping-exchanges-the-colors-of-the-players = sub {
$^game.make-move($_) for <a1 swap>;
ok $^player1.color == 2 && $^player2.color == 1,
"swapping exchanges the colors of the players";
}
-our sub swapping-makes-it-the-second-player's-turn-again {
+my &*swapping-makes-it-the-second-player's-turn-again = sub {
$^game.make-move($_) for <a1 swap>;
is $game.player-to-move, 2,
"swapping makes it the second player's turn again";
}
-our sub passing-does-not-change-the-board {
+my &*passing-does-not-change-the-board = sub {
$^game.make-move($_) for <a2 b3 c1 b3>;
my @heights-snapshot = $game.heights;
my @colors-snapshot = $game.colors;
@@ -202,23 +199,23 @@ our sub passing-does-not-change-the-board {
"passing does not change the board";
}
-our sub passing-makes-it-the-other-player's-turn {
+my &*passing-makes-it-the-other-player's-turn = sub {
$^game.make-move('pass');
is $game.player-to-move, 2,
"passing makes it the other player's turn";
}
-our sub passing-twice-ends-the-game {
+my &*passing-twice-ends-the-game = sub {
$^game.make-move($_) for <pass pass>;
ok $game.finished, "passing twice ends the game";
}
-our sub resigning-must-have-a-certain-syntax {
+my &*resigning-must-have-a-certain-syntax = sub {
ok (defined $^game.make-move('resign')),
"resigning must have a certain syntax";
}
-our sub resigning-does-not-change-the-board {
+my &*resigning-does-not-change-the-board = sub {
$^game.make-move($_) for <a2 b3 c1 b3>;
my @heights-snapshot = $game.heights;
my @colors-snapshot = $game.colors;
@@ -228,21 +225,24 @@ our sub resigning-does-not-change-the-board {
"resigning does not change the board";
}
-our sub resigning-ends-the-game {
+my &*resigning-ends-the-game = sub {
$^game.make-move('resign');
ok $game.finished, "resigning ends the game";
}
-our sub a-chain-wins-the-game-if-it-connects-a-player's-edges {
+my &*a-chain-wins-the-game-if-it-connects-a-player's-edges = sub {
$^game.make-move($_) for <b1 b2 c1 b2 c2 b2 c3>;
ok $game.finished,
"a chain wins the game if it connects a player's edges";
}
-our sub a-chain-does-not-win-the-game-if-it-connects-the-enemy's-edges {
+my &*a-chain-does-not-win-the-game-if-it-connects-the-enemy's-edges = sub {
$^game.make-move($_) for <a2 b1 b2 b1 c2>;
ok !$game.finished,
"a chain does not win the game if it connects the enemy's edges";
}
+plan count-tests(@tests);
+run-tests(@tests);
+
# vim: filetype=perl6
Please sign in to comment.
Something went wrong with that request. Please try again.