HS: fix IO suspension via _cek_io_suspend_hook (workaround cek_run resume bug)
cek_run's resolver → cek_resume doesn't propagate values correctly (likely a kont frame ordering issue in the transpiled evaluator). Workaround: use _cek_io_suspend_hook which receives the suspended state and manually steps to completion, handling further suspensions. - resolve_io: shared function for IO resolution (sleep, fetch, etc.) - Suspend hook: manual step loop after cek_resume, handles nested IO - run_with_io: uses req_list extraction (handles ListRef) - Fixes fetch tests: 10 now pass (response format correct) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user