open Nock_lib.Noun open Nock_lib.Serial (** Test utilities *) let assert_equal expected actual msg = if not (equal expected actual) then begin Printf.printf "FAIL: %s\n" msg; Format.printf " Expected: %a@." pp_noun expected; Format.printf " Actual: %a@." pp_noun actual; exit 1 end else Printf.printf "PASS: %s\n" msg let _assert_bytes_equal expected actual msg = if expected <> actual then begin Printf.printf "FAIL: %s\n" msg; Printf.printf " Expected: %s\n" (bytes_to_hex expected); Printf.printf " Actual: %s\n" (bytes_to_hex actual); exit 1 end else Printf.printf "PASS: %s\n" msg (** Round-trip test: jam then cue should give original *) let test_roundtrip noun msg = let jammed = jam noun in let cued = cue jammed in assert_equal noun cued msg (** Test basic atoms *) let test_atoms () = Printf.printf "\n=== Testing atom serialization ===\n"; (* Test 0 *) let n = atom 0 in test_roundtrip n "atom 0 roundtrip"; (* Test small atoms *) test_roundtrip (atom 1) "atom 1 roundtrip"; test_roundtrip (atom 2) "atom 2 roundtrip"; test_roundtrip (atom 42) "atom 42 roundtrip"; test_roundtrip (atom 255) "atom 255 roundtrip"; test_roundtrip (atom 256) "atom 256 roundtrip"; (* Test larger atoms *) test_roundtrip (atom 65535) "atom 65535 roundtrip"; test_roundtrip (atom 1000000) "atom 1000000 roundtrip" (** Test basic cells *) let test_cells () = Printf.printf "\n=== Testing cell serialization ===\n"; (* Simple cell [1 2] *) let c = cell (atom 1) (atom 2) in test_roundtrip c "cell [1 2] roundtrip"; (* Nested cells [[1 2] 3] *) let c = cell (cell (atom 1) (atom 2)) (atom 3) in test_roundtrip c "cell [[1 2] 3] roundtrip"; (* Deep nesting *) let c = cell (cell (cell (atom 1) (atom 2)) (atom 3)) (atom 4) in test_roundtrip c "cell [[[1 2] 3] 4] roundtrip"; (* Larger values *) let c = cell (atom 1000) (atom 2000) in test_roundtrip c "cell [1000 2000] roundtrip" (** Test trees *) let test_trees () = Printf.printf "\n=== Testing tree serialization ===\n"; (* Binary tree *) let tree = cell (cell (atom 1) (atom 2)) (cell (atom 3) (atom 4)) in test_roundtrip tree "binary tree roundtrip"; (* Unbalanced tree *) let tree = cell (atom 1) (cell (atom 2) (cell (atom 3) (atom 4))) in test_roundtrip tree "right-leaning tree roundtrip"; (* List-like structure [1 [2 [3 0]]] *) let list = cell (atom 1) (cell (atom 2) (cell (atom 3) (atom 0))) in test_roundtrip list "list-like structure roundtrip" (** Test backreferences When the same sub-noun appears multiple times, jam should use backreferences *) let test_backrefs () = Printf.printf "\n=== Testing backreferences ===\n"; (* Create a noun with shared structure: [42 42] The second 42 should be a backref to the first *) let shared = atom 42 in let n = cell shared shared in test_roundtrip n "shared atom [42 42] roundtrip"; (* More complex sharing: [[1 2] [1 2]] Second cell should backref to first *) let sub = cell (atom 1) (atom 2) in let n = cell sub sub in test_roundtrip n "shared cell [[1 2] [1 2]] roundtrip"; (* Test that backrefs actually save space *) let sub = cell (atom 100) (atom 200) in let with_backref = cell sub sub in let without_backref = cell (cell (atom 100) (atom 200)) (cell (atom 100) (atom 200)) in let jammed_with = jam with_backref in let jammed_without = jam without_backref in Printf.printf " Shared structure size: %d bytes\n" (Bytes.length jammed_with); Printf.printf " Duplicated structure size: %d bytes\n" (Bytes.length jammed_without); (* Note: Due to how OCaml constructs values, physical equality might not work as expected, but logical equality should still work for roundtrip *) test_roundtrip with_backref "backref optimization roundtrip" (** Test known encodings These test vectors would ideally come from the Vere test suite or Urbit dojo *) let test_known_encodings () = Printf.printf "\n=== Testing known encodings ===\n"; (* We can generate these from Urbit with (jam 0), (jam 1), etc. *) (* jam of 0 should be simple *) let n = atom 0 in let jammed = jam n in Printf.printf " jam(0) = %s (%d bytes)\n" (bytes_to_hex jammed) (Bytes.length jammed); test_roundtrip n "known encoding: 0"; (* jam of 1 *) let n = atom 1 in let jammed = jam n in Printf.printf " jam(1) = %s (%d bytes)\n" (bytes_to_hex jammed) (Bytes.length jammed); test_roundtrip n "known encoding: 1"; (* jam of [0 0] *) let n = cell (atom 0) (atom 0) in let jammed = jam n in Printf.printf " jam([0 0]) = %s (%d bytes)\n" (bytes_to_hex jammed) (Bytes.length jammed); test_roundtrip n "known encoding: [0 0]" (** Test edge cases *) let test_edge_cases () = Printf.printf "\n=== Testing edge cases ===\n"; (* Very large atom *) let big = Atom (Z.of_string "123456789012345678901234567890") in test_roundtrip big "very large atom roundtrip"; (* Deep nesting *) let rec make_deep n = if n = 0 then atom 0 else cell (atom n) (make_deep (n - 1)) in let deep = make_deep 50 in test_roundtrip deep "deeply nested structure (50 levels) roundtrip"; (* Wide tree *) let rec make_wide n = if n = 0 then atom 0 else cell (make_wide (n - 1)) (make_wide (n - 1)) in let wide = make_wide 6 in (* 2^6 = 64 leaves *) test_roundtrip wide "wide binary tree (6 levels) roundtrip" (** Run all tests *) let () = Printf.printf "=================================\n"; Printf.printf "Jam/Cue Serialization Test Suite\n"; Printf.printf "=================================\n"; test_atoms (); test_cells (); test_trees (); test_backrefs (); test_known_encodings (); test_edge_cases (); Printf.printf "\n=================================\n"; Printf.printf "All tests passed!\n"; Printf.printf "=================================\n"