diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 90ca8d6b..a63da8c6 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -2149,16 +2149,19 @@ let run_spec_tests env test_files = Hashtbl.replace mock_body "textContent" (String ""); Nil); - (* IO suspension resolver — handles perform/wait/fetch in event handlers. - Requests come as Lists: ("op-name" arg1 arg2 ...) or Dicts with "op" key *) - Sx_types._cek_io_resolver := Some (fun request _suspended -> - let op, args = match request with - | List (String op :: rest) -> op, rest - | Dict d -> - let op = match Hashtbl.find_opt d "op" with Some (String s) -> s | _ -> "" in - let a = match Hashtbl.find_opt d "args" with Some (List l) -> l | _ -> [] in - op, a - | _ -> "", [] + (* IO resolution function — used by both run_with_io and _cek_io_suspend_hook *) + let resolve_io request = + let req_list = match request with List l -> l | ListRef { contents = l } -> l | _ -> [] in + let op, args = match req_list with + | String op :: rest -> op, rest + | Symbol op :: rest -> op, rest + | _ -> + (match request with + | Dict d -> + let op = match Hashtbl.find_opt d "op" with Some (String s) -> s | _ -> "" in + let a = match Hashtbl.find_opt d "args" with Some (List l) -> l | _ -> [] in + op, a + | _ -> "", []) in match op with | "io-sleep" | "io-wait" | "io-settle" | "io-wait-for" -> Nil @@ -2178,7 +2181,32 @@ let run_spec_tests env test_files = Hashtbl.replace resp "text" (String body); Dict resp | _ -> String body) - | _ -> Nil); + | _ -> Nil + in + + (* Use suspend hook (not resolver) — cek_run's resume has a propagation bug. + The hook receives the suspended state and must return the final value. *) + Sx_types._cek_io_resolver := None; + Sx_types._cek_io_suspend_hook := Some (fun suspended -> + let request = Sx_ref.cek_io_request suspended in + let response = resolve_io request in + (* Resume by manually stepping from the resumed state *) + let resumed = Sx_ref.cek_resume suspended response in + let is_terminal st = match Sx_ref.cek_terminal_p st with Bool true -> true | _ -> false in + let is_suspended st = match Sx_runtime.get_val st (String "phase") with String "io-suspended" -> true | _ -> false in + let s = ref resumed in + while not (is_terminal !s) && not (is_suspended !s) do + (try s := Sx_ref.cek_step !s + with Sx_types.CekPerformRequest req -> + let resp = resolve_io req in + s := Sx_ref.cek_resume (Sx_ref.make_cek_suspended req (Sx_ref.cek_env !s) (Sx_ref.cek_kont !s)) resp) + done; + if is_suspended !s then + let req2 = Sx_ref.cek_io_request !s in + let resp2 = resolve_io req2 in + Sx_ref.cek_value (Sx_ref.cek_resume !s resp2) + else + Sx_ref.cek_value !s); (* Load modules needed by tests *) let spec_dir = Filename.concat project_dir "spec" in @@ -2417,32 +2445,6 @@ let run_spec_tests env test_files = code-from-value, and other late-bound functions must be visible. *) !_jit_refresh_globals (); - (* Rebind try-call to use eval_with_io for IO-aware test execution *) - ignore (Sx_types.env_bind env "try-call" (NativeFn ("try-call", fun args -> - match args with - | [thunk] -> - Sx_ref.step_limit := 0; - Sx_ref.step_count := 0; - (try - ignore (eval_with_io (List [thunk]) (Env env)); - Sx_ref.step_limit := 0; - let d = Hashtbl.create 2 in - Hashtbl.replace d "ok" (Bool true); - Dict d - with - | Eval_error msg -> - Sx_ref.step_limit := 0; - let d = Hashtbl.create 2 in - Hashtbl.replace d "ok" (Bool false); - Hashtbl.replace d "error" (String msg); - Dict d - | exn -> - Sx_ref.step_limit := 0; - let d = Hashtbl.create 2 in - Hashtbl.replace d "ok" (Bool false); - Hashtbl.replace d "error" (String (Printexc.to_string exn)); - Dict d) - | _ -> raise (Eval_error "try-call: expected 1 arg")))); List.iter (fun path -> if Sys.file_exists path then begin