diff options
author | polwex <polwex@sortug.com> | 2025-10-06 23:18:59 +0700 |
---|---|---|
committer | polwex <polwex@sortug.com> | 2025-10-06 23:18:59 +0700 |
commit | 5de3f7a3ad7b0cf63b4a6cbddfc1e26359dea161 (patch) | |
tree | b55b2258123149bed40bd89bbaa58e7da54f3a26 /ocaml/test/test_parallel_nock.ml | |
parent | fdab65f6dac4ba85ed4749f61970660d1132d453 (diff) |
cleaned up tests
Diffstat (limited to 'ocaml/test/test_parallel_nock.ml')
-rw-r--r-- | ocaml/test/test_parallel_nock.ml | 244 |
1 files changed, 0 insertions, 244 deletions
diff --git a/ocaml/test/test_parallel_nock.ml b/ocaml/test/test_parallel_nock.ml deleted file mode 100644 index 2f3d39a..0000000 --- a/ocaml/test/test_parallel_nock.ml +++ /dev/null @@ -1,244 +0,0 @@ -(* Parallel Nock Tests - THE BREAKTHROUGH! - * - * These tests prove that Urbit can run on multiple CPU cores! - * - * Tests: - * 1. Parallel batch execution - * 2. Parallel scry (read-only queries) - * 3. Map-reduce style parallelism - * 4. Async execution - * 5. Parallel speedup benchmarks - *) - -open Nock_lib - -let test_domain_pool _env = - Printf.printf "Test: Domain pool creation...\n"; - - let pool = Domain_pool.create () in - let stats = Domain_pool.stats pool in - - Printf.printf " Domains in pool: %d\n" stats.num_domains; - Printf.printf " Available cores: %d\n" stats.available_cores; - - assert (stats.num_domains >= 1); - assert (stats.num_domains <= stats.available_cores); - - Domain_pool.shutdown pool; - - Printf.printf " ✓ Domain pool works!\n\n" - -let test_parallel_batch _env = - Printf.printf "Test: Parallel batch execution...\n"; - - let pool = Domain_pool.create () in - - (* Create batch of computations: increment 100 numbers *) - let computations = List.init 100 (fun i -> - let subject = Noun.atom i in - let formula = Noun.cell (Noun.atom 4) (Noun.cell (Noun.atom 0) (Noun.atom 1)) in (* [4 0 1] = increment subject *) - (subject, formula) - ) in - - Printf.printf " Executing %d Nock computations in parallel...\n" (List.length computations); - - let start = Unix.gettimeofday () in - let results = Nock_parallel.parallel_batch pool computations in - let time = Unix.gettimeofday () -. start in - - Printf.printf " Completed in %.4f seconds\n" time; - - (* Check all succeeded *) - let successes = List.filter (function - | Nock_parallel.Success _ -> true - | _ -> false - ) results in - - Printf.printf " Successes: %d/%d\n" (List.length successes) (List.length results); - - (* Print first few errors if any *) - if List.length successes < List.length computations then begin - Printf.printf " First few errors:\n"; - let errors = List.filter (function - | Nock_parallel.Error _ -> true - | _ -> false - ) results in - List.iteri (fun i result -> - if i < 3 then - match result with - | Nock_parallel.Error msg -> Printf.printf " Error %d: %s\n" i msg - | _ -> () - ) errors - end; - - assert (List.length successes = List.length computations); - - Domain_pool.shutdown pool; - - Printf.printf " ✓ Parallel batch execution works!\n\n" - -let test_parallel_scry _env = - Printf.printf "Test: Parallel scry (read-only queries)...\n"; - - let pool = Domain_pool.create () in - - (* Create a "kernel state" *) - let state = Noun.cell (Noun.atom 42) (Noun.atom 99) in - - (* Create 50 scry queries: all just read the head *) - let queries = List.init 50 (fun _ -> - Noun.cell (Noun.atom 0) (Noun.atom 2) (* Formula: [0 2] = head *) - ) in - - Printf.printf " Executing %d scry queries in parallel...\n" (List.length queries); - - let start = Unix.gettimeofday () in - let results = Nock_parallel.parallel_scry pool state queries in - let time = Unix.gettimeofday () -. start in - - Printf.printf " Completed in %.4f seconds\n" time; - - (* All should return 42 (the head) *) - let successes = List.filter_map (function - | Nock_parallel.Success noun -> Some noun - | _ -> None - ) results in - - let all_correct = List.for_all (fun noun -> - noun = Noun.atom 42 - ) successes in - - assert all_correct; - - Printf.printf " All %d queries returned correct results\n" (List.length successes); - - Domain_pool.shutdown pool; - - Printf.printf " ✓ Parallel scry works! (This is huge for serving many clients!)\n\n" - -let test_async_execution _env = - Printf.printf "Test: Async Nock execution...\n"; - - let pool = Domain_pool.create () in - - (* Launch 10 async Nock computations *) - let promises = List.init 10 (fun i -> - let subject = Noun.atom i in - let formula = Noun.cell (Noun.atom 4) (Noun.cell (Noun.atom 0) (Noun.atom 1)) in (* [4 0 1] = increment *) - Nock_parallel.async_nock pool subject formula - ) in - - Printf.printf " Launched %d async computations\n" (List.length promises); - - (* Wait for all to complete *) - let results = List.map (fun promise -> - Domainslib.Task.await pool.Domain_pool.pool promise - ) promises in - - let successes = List.filter (function - | Nock_parallel.Success _ -> true - | _ -> false - ) results in - - Printf.printf " Completed: %d/%d\n" (List.length successes) (List.length promises); - - assert (List.length successes = List.length promises); - - Domain_pool.shutdown pool; - - Printf.printf " ✓ Async execution works!\n\n" - -let test_parallel_speedup _env = - Printf.printf "Test: Parallel speedup benchmark...\n"; - - let pool = Domain_pool.create () in - let stats = Domain_pool.stats pool in - - Printf.printf " Testing with %d domains across %d cores\n" - stats.num_domains stats.available_cores; - - (* Run benchmark with increasing workload *) - let counts = [10; 50; 100; 500] in - - List.iter (fun count -> - Printf.printf "\n === Workload: %d increments ===\n" count; - - let bench = Nock_parallel.parallel_increment_bench pool count in - - Printf.printf " Sequential: %.4f seconds\n" bench.sequential_time; - Printf.printf " Parallel: %.4f seconds\n" bench.parallel_time; - Printf.printf " Speedup: %.2fx\n" bench.speedup; - Printf.printf " Correct: %b\n" bench.results_match; - - assert bench.results_match; - - if bench.speedup > 1.0 then - Printf.printf " ✓ Parallel is faster!\n" - else if count < 100 then - Printf.printf " (Small workload - overhead dominates)\n" - else - Printf.printf " (Note: Speedup limited by workload size)\n" - ) counts; - - Domain_pool.shutdown pool; - - Printf.printf "\n ✓ Benchmark complete!\n\n" - -let test_large_parallel_batch _env = - Printf.printf "Test: Large parallel batch (1000 computations)...\n"; - - let pool = Domain_pool.create () in - - (* Create 1000 computations *) - let computations = List.init 1000 (fun i -> - let subject = Noun.atom i in - let formula = Noun.cell (Noun.atom 4) (Noun.cell (Noun.atom 0) (Noun.atom 1)) in (* [4 0 1] = increment *) - (subject, formula) - ) in - - Printf.printf " Executing %d Nock computations...\n" (List.length computations); - - let start = Unix.gettimeofday () in - let results = Nock_parallel.parallel_batch pool computations in - let time = Unix.gettimeofday () -. start in - - let successes = List.filter (function - | Nock_parallel.Success _ -> true - | _ -> false - ) results in - - Printf.printf " Completed %d/%d in %.4f seconds\n" - (List.length successes) (List.length results) time; - - Printf.printf " Throughput: %.0f ops/sec\n" - (float_of_int (List.length successes) /. time); - - assert (List.length successes = 1000); - - Domain_pool.shutdown pool; - - Printf.printf " ✓ Large batch processing works!\n\n" - -let () = - Eio_main.run @@ fun env -> - Printf.printf "\n🚀🚀🚀 === PARALLEL NOCK TESTS === 🚀🚀🚀\n\n"; - Printf.printf "OCaml %s with %d CPU cores available\n\n" - Sys.ocaml_version (Domain.recommended_domain_count ()); - - test_domain_pool env; - test_parallel_batch env; - test_parallel_scry env; - test_async_execution env; - test_parallel_speedup env; - test_large_parallel_batch env; - - Printf.printf "🎉🎉🎉 === ALL PARALLEL NOCK TESTS PASSED! === 🎉🎉🎉\n\n"; - Printf.printf "🔥 THE BREAKTHROUGH IS REAL! 🔥\n\n"; - Printf.printf "We just proved:\n"; - Printf.printf "- Nock can run across multiple CPU cores ✓\n"; - Printf.printf "- Parallel scry for serving many clients ✓\n"; - Printf.printf "- Async execution for non-blocking operations ✓\n"; - Printf.printf "- Parallel speedup (faster than sequential!) ✓\n\n"; - Printf.printf "C Vere is stuck on 1 core. We can use ALL %d cores!\n" - (Domain.recommended_domain_count ()); - Printf.printf "\nThis changes EVERYTHING for Urbit scalability! 🚀\n" |