Permalink
Browse files

switched from using oUnit to Ospecl

  • Loading branch information...
1 parent 3555b67 commit f92180a4fdeee72e498a03c20ccdfe1c866bc6dd @rapha committed Mar 31, 2011
Showing with 292 additions and 268 deletions.
  1. +14 −11 Makefile
  2. +278 −0 spec.ml
  3. +0 −257 test.ml
View
@@ -1,20 +1,23 @@
-all: test
+all: spec
clean:
rm *.cm* *.byte
-game.cma: piece.ml board.mli board.ml player.ml ai.ml game.ml
- ocamlfind ocamlc -a -package batteries piece.ml board.mli board.ml player.ml ai.ml game.ml -o game.cma
+game.cma: piece.ml column.mli column.ml board.mli board.ml player.ml ai.ml game.ml
+ $(OCAMLC) -a -package batteries piece.ml column.mli column.ml board.mli board.ml player.ml ai.ml game.ml -o game.cma
-test.byte: game.cma test.ml
- ocamlfind ocamlc -thread -package batteries,oUnit -linkpkg game.cma test.ml -o test.byte
+spec.byte: game.cma spec.ml
+ $(OCAMLC) -thread -package batteries,ospecl -linkpkg game.cma spec.ml -o spec.byte
-test: test.byte
- ./test.byte
+spec: spec.byte
+ ocamlrun -b ./spec.byte
-tui: test
- ocamlfind ocamlc -thread -package batteries -linkpkg game.cma tui.ml -o tui.byte
+tui.byte: game.cma tui.ml
+ $(OCAMLC) -thread -package batteries -linkpkg game.cma tui.ml -o tui.byte
-gui: test
- ocamlfind ocamlc -thread -package batteries,labltk -linkpkg game.cma gui.ml -o gui.byte
+gui.byte: game.cma gui.ml
+ $(OCAMLC) -thread -package batteries,labltk -linkpkg game.cma gui.ml -o gui.byte
+.PHONY: all clean spec
+
+OCAMLC = ocamlfind ocamlc -g
View
@@ -0,0 +1,278 @@
+open Batteries
+
+open Ospecl.Spec
+open Ospecl.Matchers
+
+module TestGame = Game.Make(Board)
+
+let _ =
+ let lines = Str.split (Str.regexp "\n") in
+ let drop_in col _ _ = col in
+
+ let (|>) x f = f x in
+
+ Ospecl.Run.console [
+ describe "Piece.to_string and Piece.of_string are inverse" begin
+ let open Piece in [
+ it "piece -> string -> piece" (fun() ->
+ let equal_to_piece = equal_to to_string in
+
+ A |> to_string |> of_string =~ is (equal_to_piece A)
+ );
+ it "string -> piece -> string" (fun() ->
+ "A" |> of_string |> to_string =~ is (equal_to_string "A")
+ );
+ ] end;
+ describe "Board" begin
+ let open Board in [
+ describe ".drop" [
+ describe "in an empty column" [
+ it "puts a piece on the first row of that column" (fun _ ->
+ let expected = build ["A------"] |> to_string in
+
+ empty |> drop Piece.A 0 |> to_string =~ is (equal_to_string expected)
+ );
+ ];
+ describe "in a full column" [
+ it "raises Column_full" (fun() ->
+ let board = build [
+ "B------";
+ "A------";
+ "B------";
+ "A------";
+ "B------";
+ "A------";
+ ] in
+
+ (fun () -> board |> drop Piece.A 0) =~ does (raise_exn (Column_full 0))
+ );
+ ];
+ ];
+
+ describe ".has_won" [
+ describe "on an empty board" [
+ it "is false for both players" (fun _ ->
+ empty |> has_won Piece.A =~ is false';
+ empty |> has_won Piece.B =~ is false'
+ )
+ ];
+ it "is false for vertical line of 3" (fun() ->
+ let board = build [
+ "A------";
+ "A------";
+ "A------"]
+ in board |> has_won Piece.A =~ is false'
+ );
+ it "is true for vertical line of 4" (fun() ->
+ let board = build [
+ "A------";
+ "A------";
+ "A------";
+ "A------"]
+ in board |> has_won Piece.A =~ is true'
+ );
+ it "is false for horizontal line of 3" (fun() ->
+ let board = build [
+ "AAA----"]
+ in board |> has_won Piece.A =~ is false'
+ );
+ it "is true for horizontal line of 4" (fun() ->
+ let board = build [
+ "AAAA---"]
+ in board |> has_won Piece.A =~ is true'
+ );
+ it "is false for NE line of 3" (fun() ->
+ let board = build [
+ "--A----";
+ "-AB----";
+ "ABB----"]
+ in board |> has_won Piece.A =~ is false'
+ );
+ it "is true for NE line of 4" (fun() ->
+ let board = build [
+ "---A---";
+ "--AB---";
+ "-ABB---";
+ "ABBB---"]
+ in board |> has_won Piece.A =~ is true'
+ );
+ it "is false for NW line of 3" (fun() ->
+ let board = build [
+ "A------";
+ "BA-----";
+ "BBA----"]
+ in board |> has_won Piece.A =~ is false'
+ );
+ it "is true for NW line of 4" (fun() ->
+ let board = build [
+ "A------";
+ "BA-----";
+ "BBA----";
+ "BBBA---"]
+ in board |> has_won Piece.A =~ is true'
+ );
+ it "is false when there is a gap in the line" (fun() ->
+ let board = build [
+ "----B--";
+ "---BB--";
+ "--BAA--";
+ "--AAA--";
+ "B-AAA--"]
+ in board |> has_won Piece.B =~ is false'
+ );
+ ];
+ describe ".to_string" [
+ it "for empty board is 6 row by 7 cols of -" (fun() ->
+ let expected = (
+ "- - - - - - -\n" ^
+ "- - - - - - -\n" ^
+ "- - - - - - -\n" ^
+ "- - - - - - -\n" ^
+ "- - - - - - -\n" ^
+ "- - - - - - -\n" )
+ in empty |> to_string =~ is (equal_to_string expected)
+ );
+ ];
+ ] end;
+
+ describe "Game.play_turn" [
+ it "uses function passed in to get row to drop in" (fun() ->
+ let col = ref None in
+ let module TestGame = Game.Make (struct include Board
+ let drop _ c board =
+ col := Some c;
+ board
+ end) in
+
+ let players = Player.create_pair (drop_in 3, drop_in 0) in
+
+ TestGame.create players |> TestGame.play_turn |> ignore;
+
+ let equal_to_int_option = equal_to (function None -> "None" | Some n -> "Some " ^ (string_of_int n)) in
+
+ !col =~ is (equal_to_int_option (Some 3))
+ );
+ it "calls drop handler" (fun() ->
+ let drop_handled = ref false in
+ let handler = function (1,3,Piece.A) -> drop_handled := true | _ -> () in
+
+ Player.create_pair (drop_in 3, drop_in 2) |> TestGame.create |> TestGame.on_drop handler |>
+ TestGame.play_turn |> ignore;
+
+ !drop_handled =~ is true'
+ );
+ it "calls switch player handler" (fun() ->
+ let switch_handled = ref false in
+ let handler = function Piece.B -> switch_handled := true | _ -> () in
+
+ Player.create_pair (drop_in 1, drop_in 2) |> TestGame.create |> TestGame.on_switch handler |>
+ TestGame.play_turn |> ignore;
+
+ !switch_handled =~ is true'
+ );
+ it "calls win handler" (fun() ->
+ let win_handled = ref false in
+ let handler = function Piece.A -> win_handled := true | _ -> () in
+ let play_turn = TestGame.play_turn in
+ let game = Player.create_pair (drop_in 1, drop_in 2) |> TestGame.create |> TestGame.on_win handler |>
+ play_turn |> play_turn |>
+ play_turn |> play_turn |>
+ play_turn |> play_turn in
+
+ game |> play_turn |> ignore;
+
+ !win_handled =~ is true'
+ );
+ it "toggles current piece" (fun() ->
+ let history = ref [] in
+ let handler a = history := (a :: !history) in
+ Player.create_pair (drop_in 3, drop_in 2) |> TestGame.create |> TestGame.on_switch handler |>
+
+ TestGame.play_turn |> TestGame.play_turn |> TestGame.play_turn |> ignore;
+
+ let equal_to_piece_list = equal_to (List.fold_left (fun str piece -> str ^ "," ^ (Piece.to_string piece)) "") in
+
+ !history =~ is (equal_to_piece_list [Piece.B;Piece.A;Piece.B])
+ );
+ ];
+
+ describe "AI" [
+ describe ".minimax" begin
+ let equal_to_float = within 0.0001 in [
+
+ it "returns 0 if empty" (fun() ->
+ let module TestAI = Ai.Make(Board) in
+
+ Board.empty |> TestAI.minimax 0 Piece.A Piece.A TestAI.winning_score =~ is (equal_to_float 0.)
+ );
+ it "returns losing score if opponent has won" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let has_won player board =
+ player = Piece.B
+ end) in
+
+ TestAI.minimax 0 Piece.A Piece.A TestAI.winning_score Board.empty =~ is (equal_to_float TestAI.losing_score)
+ );
+ it "with depth 0 returns value from eval function" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let evaluate _ _ = 5.
+ end) in
+
+ TestAI.minimax 0 Piece.A Piece.A TestAI.winning_score Board.empty =~ is (equal_to_float 5.)
+ );
+ it "with depth 1 returns winning score if player can win this turn" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let has_won player board =
+ player = Piece.A
+ end) in
+
+ TestAI.minimax 1 Piece.A Piece.A TestAI.winning_score Board.empty =~ is (equal_to_float TestAI.winning_score)
+ );
+ it "with depth 1 returns highest values from eval function after this turn" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let evaluate player board =
+ match board |> to_string |> lines |> List.last with
+ | "- A - - - - -" -> 5.
+ | _ -> 0.
+ end) in
+
+ TestAI.minimax 1 Piece.A Piece.A TestAI.winning_score Board.empty =~ is (equal_to_float 5.)
+ );
+ it "with depth 2 returns highest of lowest eval values after 2 turns" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let evaluate player board =
+ let bottom_row = board |> to_string |> lines |> List.last in
+ let col_with piece =
+ try Str.search_forward (Str.regexp (piece |> Piece.to_string)) bottom_row 0 |> flip (lsr) 1 |> (+) 1
+ with Not_found -> 0
+ in
+ (col_with Piece.A) + (col_with Piece.B) |> ( * ) (-1) |> float_of_int
+ end) in
+
+ TestAI.minimax 2 Piece.A Piece.A TestAI.winning_score Board.empty =~ is (equal_to_float (-8.))
+ );
+ it "with depth 1 returns an full score value for a full column" (fun() ->
+ let module TestAI = Ai.Make (struct include Board
+ let drop _ col _ =
+ raise (Board.Column_full col)
+ end) in
+
+ TestAI.minimax 1 Piece.A Piece.A TestAI.column_full_score Board.empty =~ is (equal_to_float TestAI.column_full_score)
+ );
+ ]
+ end;
+ describe ".choose_column" [
+ it "returns the move with the highest score" (fun() ->
+ let module Board = struct include Board
+ let evaluate _ board =
+ match board |> to_string |> lines |> List.last with
+ | "- - - A - - -" -> 1.
+ | _ -> 0.
+ end in
+ let module TestAI = Ai.Make (Board) in
+
+ TestAI.choose_column 0 Board.empty Piece.A =~ is (equal_to_int 3)
+ );
+ ];
+ ];
+ ]
Oops, something went wrong. Retry.

0 comments on commit f92180a

Please sign in to comment.