summaryrefslogtreecommitdiff
path: root/ocaml/test
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/test')
-rw-r--r--ocaml/test/dune33
-rw-r--r--ocaml/test/test_nock.ml152
-rw-r--r--ocaml/test/test_pills.ml124
-rw-r--r--ocaml/test/test_serial.ml139
-rw-r--r--ocaml/test/test_serial_v.ml206
-rw-r--r--ocaml/test/test_state.ml75
6 files changed, 729 insertions, 0 deletions
diff --git a/ocaml/test/dune b/ocaml/test/dune
new file mode 100644
index 0000000..758f9fb
--- /dev/null
+++ b/ocaml/test/dune
@@ -0,0 +1,33 @@
+(test
+ (name test_nock)
+ (modules test_nock)
+ (libraries overe.nock alcotest))
+
+(test
+ (name test_serial)
+ (modules test_serial)
+ (libraries overe.nock alcotest))
+
+(test
+ (name test_serial_v)
+ (modules test_serial_v)
+ (libraries overe.nock alcotest))
+
+(test
+ (name test_state)
+ (modules test_state)
+ (libraries overe.nock alcotest))
+
+(test
+ (name test_pills)
+ (modules test_pills)
+ (libraries overe.nock alcotest)
+ (enabled_if
+ (= %{env:RUN_PILL_TESTS=false} true))
+ (action
+ (chdir
+ %{project_root}
+ (setenv
+ NEOVERE_ROOT
+ %{project_root}
+ (run %{exe:test_pills.exe})))))
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 ]
diff --git a/ocaml/test/test_pills.ml b/ocaml/test/test_pills.ml
new file mode 100644
index 0000000..d926fc0
--- /dev/null
+++ b/ocaml/test/test_pills.ml
@@ -0,0 +1,124 @@
+open Nock_lib
+open Noun
+open Serial
+
+let read_file path =
+ let ic = open_in_bin path in
+ let len = in_channel_length ic in
+ let bytes = really_input_string ic len in
+ close_in ic;
+ Bytes.of_string bytes
+
+let rec find_project_root dir =
+ let pills_dir = Filename.concat dir "pills" in
+ if Sys.file_exists pills_dir && Sys.is_directory pills_dir then
+ dir
+ else
+ let parent = Filename.dirname dir in
+ if String.equal parent dir then
+ invalid_arg "unable to locate project root containing pills/"
+ else
+ find_project_root parent
+
+let project_root =
+ let exe_dir = Filename.dirname Sys.executable_name in
+ find_project_root exe_dir
+
+let pill_path name = Filename.concat project_root (Filename.concat "pills" name)
+
+let pill_paths = List.map pill_path [ "baby.pill"; "ivory.pill" ]
+
+let test_pill path () =
+ Printf.printf "[pill] %s\n%!" path;
+ let bytes = read_file path in
+ let cue_noun = cue bytes in
+ Alcotest.(check bool) (path ^ " parsed") true (Noun.is_cell cue_noun)
+
+let tests = List.map (fun path -> path, `Quick, test_pill path) pill_paths
+
+let error_to_string = function
+ | Boot.Invalid_pill s -> Printf.sprintf "invalid pill: %s" s
+ | Boot.Unsupported s -> Printf.sprintf "unsupported pill: %s" s
+
+let count_list noun =
+ let rec loop acc = function
+ | Atom z when Z.equal z Z.zero -> acc
+ | Cell (_, t) -> loop (acc + 1) t
+ | _ -> Alcotest.fail "expected null-terminated list"
+ in
+ loop 0 noun
+
+let solid_event_count path =
+ let noun = cue (read_file path) in
+ match noun with
+ | Cell (tag, rest) ->
+ let pill_tag = Z.of_int 0x6c6c6970 in
+ let solid_tag = Z.of_int 0x64696c6f in
+ begin match tag, rest with
+ | Atom z, Cell (typ, payload) when Z.equal z pill_tag ->
+ begin match typ, payload with
+ | Atom t, Cell (bot, Cell (mod_, use_)) when Z.equal t solid_tag ->
+ count_list bot + count_list mod_ + count_list use_
+ | _ -> Alcotest.fail "malformed solid payload"
+ end
+ | _ -> Alcotest.fail "invalid solid pill tag"
+ end
+ | _ -> Alcotest.fail "solid pill not a cell"
+
+let test_boot_ivory () =
+ let state = State.create () in
+ match Boot.boot_ivory state (pill_path "ivory.pill") with
+ | Ok () ->
+ Alcotest.(check int64) "eve reset" 0L (State.event_number state);
+ Alcotest.(check bool) "arvo core is cell" true (Noun.is_cell (State.arvo_core state))
+ | Error err -> Alcotest.failf "boot_ivory failed: %s" (error_to_string err)
+
+let test_boot_solid () =
+ let solid_limit =
+ match Sys.getenv_opt "SOLID_LIMIT" with
+ | None -> None
+ | Some value ->
+ begin match int_of_string_opt value with
+ | Some n when n > 0 -> Some n
+ | _ -> Alcotest.fail "SOLID_LIMIT must be a positive integer"
+ end
+ in
+ match solid_limit with
+ | None ->
+ Printf.printf "[solid] skipping; set SOLID_LIMIT to replay events\n%!"
+ | Some requested_limit ->
+ let ivory = pill_path "ivory.pill" in
+ let solid = pill_path "solid.pill" in
+ let state = State.create () in
+ let total_events = solid_event_count solid in
+ if total_events = 0 then Alcotest.fail "solid pill contained no events";
+ let limit = min requested_limit total_events in
+ match Boot.boot_ivory state ivory with
+ | Error err -> Alcotest.failf "boot_ivory failed: %s" (error_to_string err)
+ | Ok () ->
+ let booted_core = State.arvo_core state in
+ let seen = ref [] in
+ let fake_apply _ event =
+ seen := event :: !seen;
+ Noun.zero
+ in
+ match Boot.boot_solid ~limit ~apply:fake_apply state solid with
+ | Error err -> Alcotest.failf "boot_solid failed: %s" (error_to_string err)
+ | Ok () ->
+ let events = List.rev !seen in
+ Alcotest.(check int) "event count" limit (List.length events);
+ Alcotest.(check int64) "eve unchanged" 0L (State.event_number state);
+ Alcotest.(check bool) "core unchanged"
+ true (Noun.equal booted_core (State.arvo_core state))
+
+
+let boot_tests = [
+ "boot_ivory", `Quick, test_boot_ivory;
+ "boot_solid", `Slow, test_boot_solid;
+]
+
+let () =
+ Alcotest.run "pills"
+ [ "pill roundtrips", tests;
+ "boot", boot_tests;
+ ]
diff --git a/ocaml/test/test_serial.ml b/ocaml/test/test_serial.ml
new file mode 100644
index 0000000..7d33148
--- /dev/null
+++ b/ocaml/test/test_serial.ml
@@ -0,0 +1,139 @@
+[@@@ocaml.warning "-32-39"]
+
+open Nock_lib
+open Noun
+open Serial
+
+let atom_int n = atom (Z.of_int n)
+
+let rec mass = function
+ | Atom z -> 1 + Z.numbits z
+ | Cell (h, t) -> 1 + mass h + mass t
+
+let noun_to_string noun =
+ let rec loop = function
+ | Atom z -> Z.to_string z
+ | Cell (h, t) -> Printf.sprintf "[%s %s]" (loop h) (loop t)
+ in
+ loop noun
+
+let bytes_to_hex bytes =
+ let buf = Buffer.create (Bytes.length bytes * 2) in
+ Bytes.iter
+ (fun byte -> Buffer.add_string buf (Printf.sprintf "%02X" (int_of_char byte)))
+ bytes;
+ Buffer.contents buf
+
+let log_roundtrip name noun jammed =
+ Printf.printf "[%s] noun=%s jam=%s (%d bytes)\n%!"
+ name (noun_to_string noun) (bytes_to_hex jammed) (Bytes.length jammed)
+
+let roundtrip name noun =
+ let jammed = jam noun in
+ log_roundtrip name noun jammed;
+ let cued = cue jammed in
+ Alcotest.(check bool) (name ^ " roundtrip") true (equal noun cued);
+ jammed
+
+let setup_stack () = ()
+
+let test_jam_cue_atom () =
+ ignore (roundtrip "test_jam_cue_atom" (atom_int 42))
+
+let test_jam_cue_cell () =
+ ignore (roundtrip "test_jam_cue_cell" (cell (atom_int 1) (atom_int 2)))
+
+let test_jam_cue_nested_cell () =
+ let inner = cell (atom_int 3) (atom_int 4) in
+ ignore (roundtrip "test_jam_cue_nested_cell" (cell (atom_int 1) inner))
+
+let test_jam_cue_shared_structure () =
+ let shared = atom_int 99 in
+ ignore (roundtrip "test_jam_cue_shared_structure" (cell shared shared))
+
+let test_jam_cue_large_atom () =
+ let noun = atom (Z.of_string "18446744073709551615") in
+ ignore (roundtrip "test_jam_cue_large_atom" noun)
+
+let test_jam_cue_empty_atom () =
+ ignore (roundtrip "test_jam_cue_empty_atom" (atom Z.zero))
+
+let test_jam_cue_complex_structure () =
+ let atom1 = atom_int 1 in
+ let atom2 = atom_int 2 in
+ let cell1 = cell atom1 atom2 in
+ let cell2 = cell cell1 atom2 in
+ let cell3 = cell cell2 cell1 in
+ ignore (roundtrip "test_jam_cue_complex_structure" cell3)
+
+let test_cue_invalid_input () =
+ let invalid = Bytes.of_string "\x03" in
+ Alcotest.check_raises "test_cue_invalid_input"
+ (Invalid_argument "read_bit: end of stream")
+ (fun () -> ignore (cue invalid))
+
+let rec space_needed_noun noun = mass noun
+
+let rec random_noun rng depth acc =
+ if depth <= 0 || Random.State.bool rng then
+ let value = Random.State.int64 rng Int64.max_int in
+ let noun = atom (Z.of_int64 value) in
+ (noun, acc + mass noun)
+ else
+ let left, left_size = random_noun rng (depth - 1) acc in
+ let right, total = random_noun rng (depth - 1) left_size in
+ let noun = cell left right in
+ (noun, total + mass noun)
+
+let generate_random_noun _stack bits rng =
+ let depth = max 1 (bits / 16) in
+ random_noun rng depth 0
+
+let rec generate_deeply_nested_noun stack depth rng =
+ if depth = 0 then
+ generate_random_noun stack 64 rng
+ else
+ let left, left_size = generate_deeply_nested_noun stack (depth - 1) rng in
+ let right, right_size = generate_deeply_nested_noun stack (depth - 1) rng in
+ let noun = cell left right in
+ (noun, left_size + right_size + mass noun)
+
+let test_jam_cue_roundtrip_property () =
+ let rng = Random.State.make [| 0x1A2B3C4D |] in
+ for depth = 1 to 6 do
+ let noun, _ = generate_deeply_nested_noun () depth rng in
+ ignore (roundtrip (Printf.sprintf "test_jam_cue_roundtrip_property depth=%d" depth) noun)
+ done
+
+let test_cue_invalid_backreference () =
+ let invalid = Bytes.of_string "\x03" in
+ Alcotest.check_raises "test_cue_invalid_backreference"
+ (Invalid_argument "read_bit: end of stream")
+ (fun () -> ignore (cue invalid))
+
+let test_cue_nondeterministic_error () =
+ Alcotest.(check bool) "test_cue_nondeterministic_error" true true
+
+let test_cell_construction () =
+ match cell (atom_int 10) (atom_int 11) with
+ | Cell (h, t) ->
+ Alcotest.(check bool) "head" true (equal h (atom_int 10));
+ Alcotest.(check bool) "tail" true (equal t (atom_int 11))
+ | Atom _ -> Alcotest.fail "expected cell"
+
+let tests = [
+ "test_jam_cue_atom", `Quick, test_jam_cue_atom;
+ "test_jam_cue_cell", `Quick, test_jam_cue_cell;
+ "test_jam_cue_nested_cell", `Quick, test_jam_cue_nested_cell;
+ "test_jam_cue_shared_structure", `Quick, test_jam_cue_shared_structure;
+ "test_jam_cue_large_atom", `Quick, test_jam_cue_large_atom;
+ "test_jam_cue_empty_atom", `Quick, test_jam_cue_empty_atom;
+ "test_jam_cue_complex_structure", `Quick, test_jam_cue_complex_structure;
+ "test_cue_invalid_input", `Quick, test_cue_invalid_input;
+ "test_jam_cue_roundtrip_property", `Quick, test_jam_cue_roundtrip_property;
+ "test_cue_invalid_backreference", `Quick, test_cue_invalid_backreference;
+ "test_cue_nondeterministic_error", `Quick, test_cue_nondeterministic_error;
+ "test_cell_construction", `Quick, test_cell_construction;
+]
+
+let () = Alcotest.run "serialization" [ "tests", tests ]
diff --git a/ocaml/test/test_serial_v.ml b/ocaml/test/test_serial_v.ml
new file mode 100644
index 0000000..2fb74cf
--- /dev/null
+++ b/ocaml/test/test_serial_v.ml
@@ -0,0 +1,206 @@
+module Noun = Nock_lib.Noun
+module Serial = Nock_lib.Serial
+
+let bytes_of_list ints =
+ let len = List.length ints in
+ let buf = Bytes.create len in
+ List.iteri
+ (fun i byte ->
+ if byte < 0 || byte > 0xFF then invalid_arg "byte out of range";
+ Bytes.set buf i (Char.chr byte))
+ ints;
+ buf
+
+let hex_of_bytes bytes =
+ let buf = Buffer.create (Bytes.length bytes * 2) in
+ Bytes.iter
+ (fun ch -> Buffer.add_string buf (Printf.sprintf "%02x" (Char.code ch)))
+ bytes;
+ Buffer.contents buf
+
+let atom_int n = Noun.atom (Z.of_int n)
+
+let atom_of_bytes ints =
+ let rec loop acc shift = function
+ | [] -> acc
+ | byte :: rest ->
+ let part = Z.shift_left (Z.of_int byte) (8 * shift) in
+ loop (Z.add acc part) (shift + 1) rest
+ in
+ Noun.atom (loop Z.zero 0 ints)
+
+let atom_of_ascii s =
+ let bytes = List.init (String.length s) (fun i -> Char.code s.[i]) in
+ atom_of_bytes bytes
+
+let pair a b = Noun.cell a b
+let trel a b c = Noun.cell a (pair b c)
+let qual a b c d = Noun.cell a (trel b c d)
+
+type case = {
+ name : string;
+ noun : Noun.noun;
+ expected : bytes;
+}
+
+let case name noun bytes =
+ { name; noun; expected = bytes_of_list bytes }
+
+let deep_case =
+ (* Direct translation of C: [[[[1 [[2 [[3 [[4 [[5 [6 [7 [[8 0] 0]]]] 0]] 0]] 0]] 0]] 0] 0] *)
+ case "deep"
+ (pair
+ (pair
+ (pair
+ (atom_int 1)
+ (pair
+ (pair
+ (atom_int 2)
+ (pair
+ (pair
+ (atom_int 3)
+ (pair
+ (pair
+ (atom_int 4)
+ (pair
+ (trel
+ (atom_int 5)
+ (atom_int 6)
+ (pair
+ (atom_int 7)
+ (pair
+ (pair (atom_int 8) (atom_int 0))
+ (atom_int 0)
+ )
+ )
+ )
+ (atom_int 0))
+ )
+ (atom_int 0))
+ )
+ (atom_int 0))
+ )
+ (atom_int 0))
+ )
+ (atom_int 0))
+ (atom_int 0))
+
+
+ [ 0x15; 0x17; 0xb2; 0xd0; 0x85; 0x59; 0xb8; 0x61;
+ 0x87; 0x5f; 0x10; 0x54; 0x55; 0x05 ]
+
+let wide_case =
+ let inp =
+ [ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x01 ]
+ in
+ case "wide" (atom_of_bytes inp)
+ [ 0x00; 0x0c; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x00; 0x00; 0x08 ]
+
+let date_case =
+ let inp =
+ [ 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x0c; 0xa8;
+ 0xab; 0x60; 0xef; 0x2d; 0x0d; 0x00; 0x00; 0x80 ]
+ in
+ case "date" (atom_of_bytes inp)
+ [ 0x00; 0x02; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00;
+ 0x18; 0x50; 0x57; 0xc1; 0xde; 0x5b; 0x1a; 0x00;
+ 0x00; 0x00; 0x01 ]
+
+let alpha_case =
+ let a = atom_of_ascii "abcdefjhijklmnopqrstuvwxyz" in
+ let noun = qual a (atom_int 2) (atom_int 3) a in
+ case "alpha" noun
+ [ 0x01; 0xf8; 0x0c; 0x13; 0x1b; 0x23; 0x2b; 0x33;
+ 0x53; 0x43; 0x4b; 0x53; 0x5b; 0x63; 0x6b; 0x73;
+ 0x7b; 0x83; 0x8b; 0x93; 0x9b; 0xa3; 0xab; 0xb3;
+ 0xbb; 0xc3; 0xcb; 0xd3; 0x87; 0x0c; 0x3d; 0x09 ]
+
+let cases =
+ [
+ case "0" (atom_int 0) [ 0x02 ];
+ case "1" (atom_int 1) [ 0x0c ];
+ case "2" (atom_int 2) [ 0x48 ];
+ case "%fast" (atom_of_ascii "fast")
+ [ 0xc0; 0x37; 0x0b; 0x9b; 0xa3; 0x03 ];
+ case "%full" (atom_of_ascii "full")
+ [ 0xc0; 0x37; 0xab; 0x63; 0x63; 0x03 ];
+ case "[0 0]"
+ (pair (atom_int 0) (atom_int 0))
+ [ 0x29 ];
+ case "[1 1]"
+ (pair (atom_int 1) (atom_int 1))
+ [ 0x31; 0x03 ];
+ case "[1 2]"
+ (pair (atom_int 1) (atom_int 2))
+ [ 0x31; 0x12 ];
+ case "[2 3]"
+ (pair (atom_int 2) (atom_int 3))
+ [ 0x21; 0xd1 ];
+ case "[%fast %full]"
+ (pair (atom_of_ascii "fast") (atom_of_ascii "full"))
+ [ 0x01; 0xdf; 0x2c; 0x6c; 0x8e; 0x0e; 0x7c; 0xb3; 0x3a; 0x36; 0x36 ];
+ case "[1 1 1]"
+ (pair (atom_int 1) (pair (atom_int 1) (atom_int 1)))
+ [ 0x71; 0xcc ];
+ case "[1 2 3]"
+ (trel (atom_int 1) (atom_int 2) (atom_int 3))
+ [ 0x71; 0x48; 0x34 ];
+ case "[%fast %full %fast]"
+ (let fast = atom_of_ascii "fast" in
+ let full = atom_of_ascii "full" in
+ pair fast (pair full fast))
+ [ 0x01; 0xdf; 0x2c; 0x6c; 0x8e; 0x1e; 0xf0; 0xcd;
+ 0xea; 0xd8; 0xd8; 0x93 ];
+ case "[[1 2] 3]"
+ (pair (pair (atom_int 1) (atom_int 2)) (atom_int 3))
+ [ 0xc5; 0x48; 0x34 ];
+ case "[[1 2] [1 2] [1 2]]"
+ (let one = atom_int 1 in
+ let two = atom_int 2 in
+ let sub = pair one two in
+ trel sub sub sub)
+ [ 0xc5; 0xc8; 0x26; 0x27; 0x01 ];
+ case "[[0 0] [[0 0] 1 1] 1 1]"
+ (pair
+ (pair (atom_int 0) (atom_int 0))
+ (pair
+ (pair
+ (pair (atom_int 0) (atom_int 0))
+ (pair (atom_int 1) (atom_int 1)))
+ (pair (atom_int 1) (atom_int 1))))
+ [ 0xa5; 0x35; 0x19; 0xf3; 0x18; 0x05 ];
+ deep_case;
+ wide_case;
+ date_case;
+ alpha_case;
+ ]
+
+let check_case { name; noun; expected } () =
+ Printf.printf "case %s:\n" name;
+ let jammed = Serial.jam noun in
+ let jam_hex = hex_of_bytes jammed in
+ let expect_hex = hex_of_bytes expected in
+ Printf.printf " jam : 0x%s\n" jam_hex;
+ Printf.printf " expect : 0x%s\n%!" expect_hex;
+ Alcotest.(check string)
+ (name ^ " jam bytes")
+ expect_hex
+ jam_hex;
+ let cued = Serial.cue expected in
+ Alcotest.(check bool)
+ (name ^ " cue roundtrip")
+ true
+ (Noun.equal noun cued)
+
+let tests =
+ List.map (fun case -> case.name, `Quick, check_case case) cases
+
+let () = Alcotest.run ~verbose:true "serial-vectors" [ "cases", tests ]
diff --git a/ocaml/test/test_state.ml b/ocaml/test/test_state.ml
new file mode 100644
index 0000000..b5c9803
--- /dev/null
+++ b/ocaml/test/test_state.ml
@@ -0,0 +1,75 @@
+open Nock_lib
+module State = Nock_lib.State
+open Noun
+
+let atom_int n = atom (Z.of_int n)
+
+let make_test_kernel ~effects ~new_core =
+ let gate_result = cell effects new_core in
+ let gate_battery = cell (atom_int 1) gate_result in
+ let gate_payload = cell (atom_int 0) (atom_int 0) in
+ let gate = cell gate_battery gate_payload in
+ let formula = cell (atom_int 0) (atom (Z.of_int 6)) in
+ let battery =
+ cell (atom_int 0)
+ (cell (atom_int 0)
+ (cell (atom_int 0) formula))
+ in
+ let payload = cell gate (atom_int 0) in
+ cell battery payload
+
+let test_boot_and_event_counter () =
+ let state = State.create () in
+ Alcotest.(check int64) "initial eve" 0L (State.event_number state);
+ let kernel = atom_int 99 in
+ State.boot state kernel;
+ Alcotest.(check bool) "kernel after boot" true (equal kernel (State.arvo_core state));
+ Alcotest.(check int64) "eve reset" 0L (State.event_number state)
+
+let test_boot_with_explicit_eve () =
+ let state = State.create () in
+ let kernel = atom_int 7 in
+ State.boot ~events_played:3L state kernel;
+ Alcotest.(check bool) "kernel after boot" true (equal kernel (State.arvo_core state));
+ Alcotest.(check int64) "eve preset" 3L (State.event_number state)
+
+let test_poke_updates_core_and_counter () =
+ let effects = atom_int 0 in
+ let new_core = atom_int 123 in
+ let kernel = make_test_kernel ~effects ~new_core in
+ Alcotest.(check bool) "axis 23" true
+ (equal (Noun.slot (Z.of_int 23) kernel) (cell (atom_int 0) (atom (Z.of_int 6))));
+ let state = State.create ~initial:kernel () in
+ let event = atom_int 42 in
+ let returned = State.poke state event in
+ Alcotest.(check bool) "effects" true (equal returned effects);
+ Alcotest.(check bool) "new core" true (equal new_core (State.arvo_core state));
+ Alcotest.(check int64) "eve increment" 1L (State.event_number state)
+
+let test_peek () =
+ let kernel = cell (atom_int 1) (atom_int 2) in
+ let state = State.create ~initial:kernel () in
+ let path = atom_int 0 in
+ match State.peek state path with
+ | Some result ->
+ Alcotest.(check bool) "peek subject" true (equal result (cell path kernel))
+ | None -> Alcotest.fail "peek should succeed"
+
+let test_snapshot_roundtrip () =
+ let kernel = cell (atom_int 5) (atom_int 6) in
+ let state = State.create ~initial:kernel () in
+ let jammed, eve = State.snapshot state in
+ Alcotest.(check int64) "snapshot eve" 0L eve;
+ let state' = State.create () in
+ State.load_snapshot state' jammed eve;
+ Alcotest.(check bool) "core restored" true (equal (State.arvo_core state') kernel)
+
+let tests = [
+ "boot", `Quick, test_boot_and_event_counter;
+ "boot preset eve", `Quick, test_boot_with_explicit_eve;
+ "poke", `Quick, test_poke_updates_core_and_counter;
+ "peek", `Quick, test_peek;
+ "snapshot", `Quick, test_snapshot_roundtrip;
+]
+
+let () = Alcotest.run "state" [ "state", tests ]