summaryrefslogtreecommitdiff
path: root/ocaml/test
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/test')
-rw-r--r--ocaml/test/bench_nock.ml132
-rw-r--r--ocaml/test/dune23
-rw-r--r--ocaml/test/test_hex.ml26
-rw-r--r--ocaml/test/test_jam_debug.ml20
-rw-r--r--ocaml/test/test_nock.ml284
-rw-r--r--ocaml/test/test_serial.ml185
6 files changed, 670 insertions, 0 deletions
diff --git a/ocaml/test/bench_nock.ml b/ocaml/test/bench_nock.ml
new file mode 100644
index 0000000..a71b3da
--- /dev/null
+++ b/ocaml/test/bench_nock.ml
@@ -0,0 +1,132 @@
+open Nock_lib.Noun
+open Nock_lib.Nock
+
+(** Benchmark utilities *)
+
+let time_ms () =
+ Unix.gettimeofday () *. 1000.0
+
+let bench_nock name subject formula iterations =
+ (* Warmup *)
+ for _i = 1 to 100 do
+ let _ = nock subject formula in ()
+ done;
+
+ (* Actual benchmark *)
+ Gc.compact ();
+ let start = time_ms () in
+
+ for _i = 1 to iterations do
+ let _result = nock subject formula in ()
+ done;
+
+ let finish = time_ms () in
+ let total = finish -. start in
+ let per_iter = total /. (float_of_int iterations) in
+ let ops_per_sec = 1000.0 /. per_iter in
+
+ Printf.printf "%-30s %8d iterations in %10.2f ms (%10.6f ms/iter, %10.0f ops/sec)\n"
+ name iterations total per_iter ops_per_sec
+
+(** Benchmarks *)
+
+let () =
+ Printf.printf "Nock Benchmark - OCaml Implementation\n";
+ Printf.printf "======================================\n\n";
+
+ let iterations = 1_000_000 in (* 1M iterations for fast ops *)
+ let slow_iters = 100_000 in (* 100K for slower ops *)
+
+ (* Benchmark 0: slot lookup *)
+ begin
+ let subject = cell (atom 42) (atom 99) in
+ let formula = cell (atom 0) (atom 2) in (* [0 2] - get head *)
+ bench_nock "Opcode 0: slot/fragment" subject formula iterations
+ end;
+
+ (* Benchmark 1: constant *)
+ begin
+ let subject = atom 0 in
+ let formula = cell (atom 1) (atom 42) in (* [1 42] *)
+ bench_nock "Opcode 1: constant" subject formula iterations
+ end;
+
+ (* Benchmark 3: is-cell *)
+ begin
+ let subject = atom 0 in
+ let formula = cell (atom 3) (cell (atom 1) (atom 42)) in (* [3 [1 42]] *)
+ bench_nock "Opcode 3: is-cell (atom)" subject formula iterations
+ end;
+
+ (* Benchmark 4: increment *)
+ begin
+ let subject = atom 0 in
+ let formula = cell (atom 4) (cell (atom 1) (atom 1000)) in (* [4 [1 1000]] *)
+ bench_nock "Opcode 4: increment" subject formula iterations
+ end;
+
+ (* Benchmark 5: equality *)
+ begin
+ let subject = atom 0 in
+ (* [5 [1 42] [1 42]] *)
+ let formula = cell (atom 5) (cell (cell (atom 1) (atom 42)) (cell (atom 1) (atom 42))) in
+ bench_nock "Opcode 5: equality (equal)" subject formula iterations
+ end;
+
+ (* Benchmark 6: if-then-else *)
+ begin
+ let subject = atom 0 in
+ (* [6 [1 0] [1 11] [1 22]] *)
+ let formula = cell (atom 6)
+ (cell (cell (atom 1) (atom 0))
+ (cell (cell (atom 1) (atom 11))
+ (cell (atom 1) (atom 22)))) in
+ bench_nock "Opcode 6: if-then-else" subject formula iterations
+ end;
+
+ (* Benchmark 7: composition *)
+ begin
+ let subject = atom 42 in
+ (* [7 [1 99] [0 1]] *)
+ let formula = cell (atom 7) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1))) in
+ bench_nock "Opcode 7: composition" subject formula iterations
+ end;
+
+ (* Benchmark 8: push *)
+ begin
+ let subject = atom 42 in
+ (* [8 [1 99] [0 1]] *)
+ let formula = cell (atom 8) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1))) in
+ bench_nock "Opcode 8: push" subject formula iterations
+ end;
+
+ (* Benchmark: Decrement-like operation (slower) *)
+ begin
+ (* [6 [5 [0 1] [1 0]] [1 0] [8 [1 0] [4 [0 3]]]] *)
+ (* This is: if(subject == 0) 0 else subject+1 (simplified) *)
+ let dec_fol = cell (atom 6)
+ (cell (cell (atom 5) (cell (cell (atom 0) (atom 1)) (cell (atom 1) (atom 0))))
+ (cell (cell (atom 1) (atom 0))
+ (cell (atom 8) (cell (cell (atom 1) (atom 0)) (cell (atom 4) (cell (atom 0) (atom 3))))))) in
+
+ let subject = atom 10 in
+ bench_nock "Complex: decrement loop" subject dec_fol slow_iters
+ end;
+
+ (* Benchmark: Tree construction *)
+ begin
+ let subject = atom 0 in
+ (* [[1 1] [1 2]] - constructs a cell *)
+ let formula = cell (cell (atom 1) (atom 1)) (cell (atom 1) (atom 2)) in
+ bench_nock "Cell construction" subject formula iterations
+ end;
+
+ (* Benchmark: Deep slot lookup *)
+ begin
+ (* Build a deep tree: [[[[1 2] 3] 4] 5] *)
+ let subject = cell (cell (cell (cell (atom 1) (atom 2)) (atom 3)) (atom 4)) (atom 5) in
+ let formula = cell (atom 0) (atom 16) in (* slot 16 = deepest left (1) *)
+ bench_nock "Deep slot lookup (depth 4)" subject formula iterations
+ end;
+
+ Printf.printf "\n"
diff --git a/ocaml/test/dune b/ocaml/test/dune
new file mode 100644
index 0000000..b0ad51d
--- /dev/null
+++ b/ocaml/test/dune
@@ -0,0 +1,23 @@
+(test
+ (name test_nock)
+ (modules test_nock)
+ (libraries nock_lib zarith))
+
+(test
+ (name test_serial)
+ (modules test_serial)
+ (libraries nock_lib zarith))
+
+(test
+ (name test_jam_debug)
+ (modules test_jam_debug)
+ (libraries nock_lib zarith))
+
+(test
+ (name bench_nock)
+ (modules bench_nock)
+ (libraries nock_lib zarith unix))
+
+(executable
+ (name test_hex)
+ (libraries nock_lib))
diff --git a/ocaml/test/test_hex.ml b/ocaml/test/test_hex.ml
new file mode 100644
index 0000000..a228682
--- /dev/null
+++ b/ocaml/test/test_hex.ml
@@ -0,0 +1,26 @@
+open Nock_lib.Noun
+open Nock_lib.Serial
+
+let () =
+ for i = 0 to 10 do
+ let n = atom i in
+ let jammed = jam n in
+ Printf.printf "jam(%d) = %s (%d bytes)\n" i (bytes_to_hex jammed) (Bytes.length jammed)
+ done
+
+let () =
+ Printf.printf "\nRound-trip tests:\n";
+ for i = 0 to 50 do
+ let n = atom i in
+ let jammed = jam n in
+ let cued = cue jammed in
+ match cued with
+ | Atom a when Z.equal a (Z.of_int i) ->
+ Printf.printf "OK: %d\n" i
+ | Atom a ->
+ Printf.printf "FAIL: %d -> %s\n" i (Z.to_string a);
+ exit 1
+ | Cell _ ->
+ Printf.printf "FAIL: %d -> cell\n" i;
+ exit 1
+ done
diff --git a/ocaml/test/test_jam_debug.ml b/ocaml/test/test_jam_debug.ml
new file mode 100644
index 0000000..cad3ee9
--- /dev/null
+++ b/ocaml/test/test_jam_debug.ml
@@ -0,0 +1,20 @@
+open Nock_lib.Noun
+open Nock_lib.Serial
+
+let () =
+ Printf.printf "Testing jam encoding:\n";
+
+ (* Test 0 *)
+ let n0 = atom 0 in
+ let j0 = jam n0 in
+ Printf.printf "jam(0) = %s\n" (bytes_to_hex j0);
+
+ (* Test 1 *)
+ let n1 = atom 1 in
+ let j1 = jam n1 in
+ Printf.printf "jam(1) = %s\n" (bytes_to_hex j1);
+
+ (* Test 2 *)
+ let n2 = atom 2 in
+ let j2 = jam n2 in
+ Printf.printf "jam(2) = %s\n" (bytes_to_hex j2);
diff --git a/ocaml/test/test_nock.ml b/ocaml/test/test_nock.ml
new file mode 100644
index 0000000..73f2ce2
--- /dev/null
+++ b/ocaml/test/test_nock.ml
@@ -0,0 +1,284 @@
+open Nock_lib.Noun
+open Nock_lib.Nock
+
+(** 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_raises_exit f msg =
+ try
+ let _ = f () in
+ Printf.printf "FAIL: %s (expected Exit exception)\n" msg;
+ exit 1
+ with Exit ->
+ Printf.printf "PASS: %s\n" msg
+
+(** Basic noun tests *)
+
+let test_noun_basics () =
+ Printf.printf "\n=== Testing basic noun operations ===\n";
+
+ (* Test atom creation *)
+ let a = atom 42 in
+ assert_equal (atom 42) a "atom creation";
+
+ (* Test cell creation *)
+ let c = cell (atom 1) (atom 2) in
+ assert_equal (atom 1) (head c) "cell head";
+ assert_equal (atom 2) (tail c) "cell tail";
+
+ (* Test is_cell and is_atom *)
+ if not (is_atom a) then Printf.printf "FAIL: is_atom on atom\n" else Printf.printf "PASS: is_atom on atom\n";
+ if not (is_cell c) then Printf.printf "FAIL: is_cell on cell\n" else Printf.printf "PASS: is_cell on cell\n";
+ if is_atom c then Printf.printf "FAIL: not is_atom on cell\n" else Printf.printf "PASS: not is_atom on cell\n";
+ if is_cell a then Printf.printf "FAIL: not is_cell on atom\n" else Printf.printf "PASS: not is_cell on atom\n"
+
+(** Test slot/fragment addressing *)
+let test_slots () =
+ Printf.printf "\n=== Testing slot/fragment addressing ===\n";
+
+ (* Build tree: [[1 2] [3 4]] *)
+ let tree = cell (cell (atom 1) (atom 2)) (cell (atom 3) (atom 4)) in
+
+ (* Test slot addressing
+ 1 = whole tree
+ 2 = head = [1 2]
+ 3 = tail = [3 4]
+ 4 = head of head = 1
+ 5 = tail of head = 2
+ 6 = head of tail = 3
+ 7 = tail of tail = 4
+ *)
+ assert_equal tree (slot Z.one tree) "slot 1 (root)";
+ assert_equal (cell (atom 1) (atom 2)) (slot (Z.of_int 2) tree) "slot 2 (head)";
+ assert_equal (cell (atom 3) (atom 4)) (slot (Z.of_int 3) tree) "slot 3 (tail)";
+ assert_equal (atom 1) (slot (Z.of_int 4) tree) "slot 4";
+ assert_equal (atom 2) (slot (Z.of_int 5) tree) "slot 5";
+ assert_equal (atom 3) (slot (Z.of_int 6) tree) "slot 6";
+ assert_equal (atom 4) (slot (Z.of_int 7) tree) "slot 7"
+
+(** Test Nock opcode 0: slot lookup *)
+let test_nock_0 () =
+ Printf.printf "\n=== Testing Nock opcode 0 (slot) ===\n";
+
+ let subject = cell (atom 4) (atom 5) in
+
+ (* *[subject [0 1]] = subject *)
+ assert_equal subject (nock subject (cell (atom 0) (atom 1))) "nock 0: axis 1";
+
+ (* *[[4 5] [0 2]] = 4 *)
+ assert_equal (atom 4) (nock subject (cell (atom 0) (atom 2))) "nock 0: axis 2";
+
+ (* *[[4 5] [0 3]] = 5 *)
+ assert_equal (atom 5) (nock subject (cell (atom 0) (atom 3))) "nock 0: axis 3"
+
+(** Test Nock opcode 1: constant *)
+let test_nock_1 () =
+ Printf.printf "\n=== Testing Nock opcode 1 (constant) ===\n";
+
+ let subject = atom 99 in
+
+ (* *[subject [1 42]] = 42 *)
+ assert_equal (atom 42) (nock subject (cell (atom 1) (atom 42))) "nock 1: return constant";
+
+ (* *[subject [1 [1 2]]] = [1 2] *)
+ assert_equal
+ (cell (atom 1) (atom 2))
+ (nock subject (cell (atom 1) (cell (atom 1) (atom 2))))
+ "nock 1: return constant cell"
+
+(** Test Nock opcode 2: recursion *)
+let test_nock_2 () =
+ Printf.printf "\n=== Testing Nock opcode 2 (nock) ===\n";
+
+ (* *[42 [2 [0 1] [1 0]]] = *[42 0] = crash *)
+ (* *[42 [2 [1 99] [1 0 1]]] = *[99 [0 1]] = 99 *)
+ 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
+ assert_equal (atom 99) (nock subject formula) "nock 2: evaluate with new subject"
+
+(** Test Nock opcode 3: is-cell *)
+let test_nock_3 () =
+ Printf.printf "\n=== Testing Nock opcode 3 (is-cell) ===\n";
+
+ (* *[42 [3 1 42]] = 1 (atom) *)
+ assert_equal (atom 1) (nock (atom 42) (cell (atom 3) (cell (atom 1) (atom 42)))) "nock 3: is-cell of atom";
+
+ (* *[42 [3 1 [1 2]]] = 0 (cell) *)
+ assert_equal
+ (atom 0)
+ (nock (atom 42) (cell (atom 3) (cell (atom 1) (cell (atom 1) (atom 2)))))
+ "nock 3: is-cell of cell"
+
+(** Test Nock opcode 4: increment *)
+let test_nock_4 () =
+ Printf.printf "\n=== Testing Nock opcode 4 (increment) ===\n";
+
+ (* *[42 [4 1 41]] = 42 *)
+ assert_equal (atom 42) (nock (atom 0) (cell (atom 4) (cell (atom 1) (atom 41)))) "nock 4: increment";
+
+ (* *[0 [4 0 1]] = 1 *)
+ assert_equal (atom 1) (nock (atom 0) (cell (atom 4) (cell (atom 0) (atom 1)))) "nock 4: increment subject"
+
+(** Test Nock opcode 5: equality *)
+let test_nock_5 () =
+ Printf.printf "\n=== Testing Nock opcode 5 (equality) ===\n";
+
+ (* *[0 [5 [1 4] [1 5]]] = 1 (not equal) *)
+ assert_equal
+ (atom 1)
+ (nock (atom 0) (cell (atom 5) (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 5)))))
+ "nock 5: not equal";
+
+ (* *[0 [5 [1 4] [1 4]]] = 0 (equal) *)
+ assert_equal
+ (atom 0)
+ (nock (atom 0) (cell (atom 5) (cell (cell (atom 1) (atom 4)) (cell (atom 1) (atom 4)))))
+ "nock 5: equal"
+
+(** Test Nock opcode 6: if-then-else *)
+let test_nock_6 () =
+ Printf.printf "\n=== Testing Nock opcode 6 (if-then-else) ===\n";
+
+ (* *[42 [6 [1 0] [1 11] [1 22]]] = 11 (if 0 then 11 else 22) *)
+ assert_equal
+ (atom 11)
+ (nock (atom 42) (cell (atom 6) (cell (cell (atom 1) (atom 0)) (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22))))))
+ "nock 6: if true";
+
+ (* *[42 [6 [1 1] [1 11] [1 22]]] = 22 (if 1 then 11 else 22) *)
+ assert_equal
+ (atom 22)
+ (nock (atom 42) (cell (atom 6) (cell (cell (atom 1) (atom 1)) (cell (cell (atom 1) (atom 11)) (cell (atom 1) (atom 22))))))
+ "nock 6: if false"
+
+(** Test Nock opcode 7: composition *)
+let test_nock_7 () =
+ Printf.printf "\n=== Testing Nock opcode 7 (composition) ===\n";
+
+ (* *[42 [7 [1 99] [0 1]]] = *[99 [0 1]] = 99 *)
+ assert_equal
+ (atom 99)
+ (nock (atom 42) (cell (atom 7) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1)))))
+ "nock 7: composition"
+
+(** Test Nock opcode 8: push *)
+let test_nock_8 () =
+ Printf.printf "\n=== Testing Nock opcode 8 (push) ===\n";
+
+ (* *[42 [8 [1 99] [0 1]]] = *[[99 42] [0 1]] = [99 42] *)
+ assert_equal
+ (cell (atom 99) (atom 42))
+ (nock (atom 42) (cell (atom 8) (cell (cell (atom 1) (atom 99)) (cell (atom 0) (atom 1)))))
+ "nock 8: push"
+
+(** Test Nock opcode 9: call *)
+let test_nock_9 () =
+ Printf.printf "\n=== Testing Nock opcode 9 (call) ===\n";
+
+ (* Simplest test: *[42 [9 1 [0 1]]]
+ = evaluate [0 1] with 42 -> 42
+ = slot 1 of 42 -> 42
+ = *[42 42] -> should crash since 42 is not a valid formula
+
+ Better test: create subject with formula at position 3
+ *[[formula value] [9 2 [0 1]]]
+ where formula = [0 3] (get tail)
+
+ Actually: *[[1 2] [9 2 [1 [0 3]]]]
+ = evaluate [1 [0 3]] with [1 2] -> [0 3]
+ = slot 2 of [1 2] -> 1
+
+ Wait, that's wrong. Let me think about what 9 does:
+ *[subject [9 axis formula]]
+ = *[subject *[*[subject formula] axis]]
+
+ So: *[[1 2] [9 3 [0 1]]]
+ = *[*[[1 2] [0 1]] 3]
+ = *[[1 2] 3]
+ = slot 3 of [1 2]
+ = 2
+
+ But that's not right either. Let me re-read the spec.
+
+ Actually from the C code:
+ seb = nock(bus, c_gal)
+ nex = slot(b_gal, seb)
+ result = nock(seb, nex)
+
+ So for [9 b c]:
+ 1. Evaluate c with subject -> seb
+ 2. Get slot b from seb -> nex (this is the formula)
+ 3. Evaluate nex with seb as subject
+
+ Test: *[[99 [4 [0 2]]] [9 3 [0 1]]]
+ 1. seb = *[[99 [4 [0 2]]] [0 1]] = [99 [4 [0 2]]]
+ 2. nex = slot 3 of [99 [4 [0 2]]] = [4 [0 2]]
+ 3. result = *[[99 [4 [0 2]]] [4 [0 2]]]
+ = increment of *[[99 [4 [0 2]]] [0 2]]
+ = increment of 99
+ = 100
+ *)
+ let subj = cell (atom 99) (cell (atom 4) (cell (atom 0) (atom 2))) in
+ assert_equal
+ (atom 100)
+ (nock subj (cell (atom 9) (cell (atom 3) (cell (atom 0) (atom 1)))))
+ "nock 9: call formula at axis 3"
+
+(** Test Nock opcode 10: hint *)
+let test_nock_10 () =
+ Printf.printf "\n=== Testing Nock opcode 10 (hint) ===\n";
+
+ (* *[42 [10 99 [1 11]]] = 11 (hint ignored) *)
+ assert_equal
+ (atom 11)
+ (nock (atom 42) (cell (atom 10) (cell (atom 99) (cell (atom 1) (atom 11)))))
+ "nock 10: hint with value (ignored)";
+
+ (* *[42 [10 [99 [1 88]] [1 11]]] = 11 (hint ignored) *)
+ assert_equal
+ (atom 11)
+ (nock (atom 42) (cell (atom 10) (cell (cell (atom 99) (cell (atom 1) (atom 88))) (cell (atom 1) (atom 11)))))
+ "nock 10: hint with computed value (ignored)"
+
+(** Test Nock cell constructor shorthand *)
+let test_nock_cons () =
+ Printf.printf "\n=== Testing Nock cons (cell auto-construction) ===\n";
+
+ (* *[42 [[1 6] [1 7]]] = [6 7] *)
+ assert_equal
+ (cell (atom 6) (atom 7))
+ (nock (atom 42) (cell (cell (atom 1) (atom 6)) (cell (atom 1) (atom 7))))
+ "nock cons: [[1 6] [1 7]]"
+
+(** Run all tests *)
+let () =
+ Printf.printf "=================================\n";
+ Printf.printf "Nock OCaml Test Suite\n";
+ Printf.printf "=================================\n";
+
+ test_noun_basics ();
+ test_slots ();
+ test_nock_0 ();
+ test_nock_1 ();
+ test_nock_2 ();
+ test_nock_3 ();
+ test_nock_4 ();
+ test_nock_5 ();
+ test_nock_6 ();
+ test_nock_7 ();
+ test_nock_8 ();
+ test_nock_9 ();
+ test_nock_10 ();
+ test_nock_cons ();
+
+ Printf.printf "\n=================================\n";
+ Printf.printf "All tests passed!\n";
+ Printf.printf "=================================\n"
diff --git a/ocaml/test/test_serial.ml b/ocaml/test/test_serial.ml
new file mode 100644
index 0000000..fca30f8
--- /dev/null
+++ b/ocaml/test/test_serial.ml
@@ -0,0 +1,185 @@
+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"
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-16 14:58:53 +0000