1 files changed, 152 insertions, 0 deletions
diff --git a/ocaml/test/test_nock.ml b/ocaml/test/test_nock.ml
new file mode 100644
index 0000000..ffa4f63
--- /dev/null
+++ b/ocaml/test/test_nock.ml
@@ -0,0 +1,152 @@
+open Nock_lib
+open Noun
+open Nock
+
+let atom = atom_of_int
+
+let check_noun name expect actual =
+  let rec to_string noun =
+    match noun with
+    | Atom z -> Z.to_string z
+    | Cell (h, t) -> Printf.sprintf "[%s %s]" (to_string h) (to_string t)
+  in
+  Printf.printf "[%s] expect=%s actual=%s\n%!"
+    name (to_string expect) (to_string actual);
+  Alcotest.(check bool) name true (equal expect actual)
+
+let check_eval name subject formula expect =
+  let result = nock subject formula in
+  check_noun name expect result
+
+let check_exit name f =
+  Alcotest.check_raises name Exit f
+
+let test_slots () =
+  let tree =
+    cell
+      (cell (atom 1) (atom 2))
+      (cell (atom 3) (atom 4))
+  in
+  check_noun "slot 1" tree (slot Z.one tree);
+  check_noun "slot 2" (cell (atom 1) (atom 2)) (slot (Z.of_int 2) tree);
+  check_noun "slot 3" (cell (atom 3) (atom 4)) (slot (Z.of_int 3) tree);
+  check_noun "slot 4" (atom 1) (slot (Z.of_int 4) tree);
+  check_noun "slot 5" (atom 2) (slot (Z.of_int 5) tree);
+  check_noun "slot 6" (atom 3) (slot (Z.of_int 6) tree);
+  check_noun "slot 7" (atom 4) (slot (Z.of_int 7) tree);
+  check_exit "slot invalid axis" (fun () -> ignore (slot Z.zero tree))
+
+let test_opcode_0 () =
+  let subject = cell (atom 4) (atom 5) in
+  check_eval "axis 1" subject (cell (atom 0) (atom 1)) subject;
+  check_eval "axis 2" subject (cell (atom 0) (atom 2)) (atom 4);
+  check_eval "axis 3" subject (cell (atom 0) (atom 3)) (atom 5)
+
+let test_opcode_1 () =
+  let subject = atom 99 in
+  check_eval "const atom" subject (cell (atom 1) (atom 42)) (atom 42);
+  check_eval "const cell" subject (cell (atom 1) (cell (atom 1) (atom 2)))
+    (cell (atom 1) (atom 2))
+
+let test_opcode_2 () =
+  let subject = atom 42 in
+  let formula =
+    cell (atom 2)
+      (cell (cell (atom 1) (atom 99))
+        (cell (atom 1) (cell (atom 0) (atom 1))))
+  in
+  check_eval "recursive eval" subject formula (atom 99)
+
+let test_opcode_3 () =
+  check_eval "cell test atom" (atom 42)
+    (cell (atom 3) (cell (atom 1) (atom 42)))
+    (atom 1);
+  check_eval "cell test cell" (atom 42)
+    (cell (atom 3) (cell (atom 1) (cell (atom 1) (atom 2))))
+    (atom 0)
+
+let test_opcode_4 () =
+  check_eval "increment constant" (atom 0)
+    (cell (atom 4) (cell (atom 1) (atom 41)))
+    (atom 42);
+  check_eval "increment subject" (atom 0)
+    (cell (atom 4) (cell (atom 0) (atom 1)))
+    (atom 1)
+
+let test_opcode_5 () =
+  check_eval "not equal" (atom 0)
+    (cell (atom 5)
+      (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 5))))
+    (atom 1);
+  check_eval "equal" (atom 0)
+    (cell (atom 5)
+      (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 4))))
+    (atom 0)
+
+let test_opcode_6 () =
+  check_eval "if zero" (atom 42)
+    (cell (atom 6)
+      (cell (cell (atom 1) (atom 0))
+        (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22)))))
+    (atom 11);
+  check_eval "if one" (atom 42)
+    (cell (atom 6)
+      (cell (cell (atom 1) (atom 1))
+        (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22)))))
+    (atom 22)
+
+let test_opcode_7 () =
+  check_eval "compose" (atom 42)
+    (cell (atom 7)
+      (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1))))
+    (atom 99)
+
+let test_opcode_8 () =
+  check_eval "push" (atom 42)
+    (cell (atom 8)
+      (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1))))
+    (cell (atom 99) (atom 42))
+
+let test_opcode_9 () =
+  let subject =
+    cell
+      (atom 99)
+      (cell (atom 4) (cell (atom 0) (atom 2)))
+  in
+  let formula =
+    cell (atom 9)
+      (cell (atom 3)
+        (cell (atom 0) (atom 1)))
+  in
+  check_eval "call formula at axis 3" subject formula (atom 100)
+
+let test_opcode_10 () =
+  check_eval "hint" (atom 42)
+    (cell (atom 10)
+      (cell (atom 99) (cell (atom 1) (atom 11))))
+    (atom 11)
+
+let test_opcode_11 () =
+  check_eval "hint dyn" (atom 42)
+    (cell (atom 11)
+      (cell (atom 99) (cell (atom 1) (atom 11))))
+    (atom 11)
+
+let tests =
+  [
+    "slots", `Quick, test_slots;
+    "opcode 0", `Quick, test_opcode_0;
+    "opcode 1", `Quick, test_opcode_1;
+    "opcode 2", `Quick, test_opcode_2;
+    "opcode 3", `Quick, test_opcode_3;
+    "opcode 4", `Quick, test_opcode_4;
+    "opcode 5", `Quick, test_opcode_5;
+    "opcode 6", `Quick, test_opcode_6;
+    "opcode 7", `Quick, test_opcode_7;
+    "opcode 8", `Quick, test_opcode_8;
+    "opcode 9", `Quick, test_opcode_9;
+    "opcode 10", `Quick, test_opcode_10;
+    "opcode 11", `Quick, test_opcode_11;
+  ]
+
+let () = Alcotest.run "nock" [ "core", tests ]