diff options
Diffstat (limited to 'ocaml/test')
| -rw-r--r-- | ocaml/test/dune | 33 | ||||
| -rw-r--r-- | ocaml/test/test_nock.ml | 152 | ||||
| -rw-r--r-- | ocaml/test/test_pills.ml | 124 | ||||
| -rw-r--r-- | ocaml/test/test_serial.ml | 139 | ||||
| -rw-r--r-- | ocaml/test/test_serial_v.ml | 206 | ||||
| -rw-r--r-- | ocaml/test/test_state.ml | 75 |
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 ] |
