coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS tests: SIGALRM + raise timeout for native OCaml loops

Browse Source 
The infinite loops in the HS parser are in transpiled native OCaml code,
not in the VM or CEK step loop. Neither step counters (in cek_step_loop,
cek_step, trampoline) nor VM instruction checks caught them because
the loops are in direct OCaml recursion.

Fix: SIGALRM handler raises Eval_error to break out of native loops.
Also sets step_limit flag to catch VM loops. Combined approach handles
both native OCaml recursion (alarm+raise) and VM bytecode (step check).

The alarm+raise can become unreliable after ~13 timeouts in a single
process, but handles the common case well. Reverts the fork-based
approach which lost inter-test state.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-14 11:57:33 +00:00
parent 3d7fffe4eb
commit e3eb46d0dc
3 changed files with 69 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
hosts/ocaml/lib/sx_ref.ml
View File

@@ -13,9 +13,11 @@ let step_limit : int ref = ref 0
let step_count : int ref = ref 0
let trampoline v =
if !step_limit > 0 then begin
incr step_count;
step_count := !step_count + 1;
if !step_count mod 1_000_000 = 0 then
Printf.eprintf "[trampoline] count=%d\n%!" !step_count;
if !step_count > !step_limit then
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded")
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (trampoline)")
end;
!trampoline_fn v
@@ -586,11 +588,27 @@ and expand_macro mac raw_args env =
NOTE: try/with wraps only cek_step, NOT the recursive call — preserving
tail recursion (critical for the millions of steps in large evaluations). *)
and cek_step_loop state =
(if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else
(* Step check BEFORE terminal test — catches TCO thunk loops *)
if !step_limit > 0 then begin
step_count := !step_count + 1;
if !step_count > !step_limit then
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (pre-check)")
end;
(if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else begin
if !step_limit > 0 then begin
step_count := !step_count + 1;
if !step_count mod 1_000_000 = 0 then
Printf.eprintf "[step] count=%d limit=%d\n%!" !step_count !step_limit;
if !step_count > !step_limit then begin
Printf.eprintf "[TIMEOUT] step_count=%d exceeded limit=%d\n%!" !step_count !step_limit;
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded")
end
end;
let next = (try cek_step (state)
with Sx_types.CekPerformRequest request ->
make_cek_suspended request (cek_env state) (cek_kont state))
in cek_step_loop next)
in cek_step_loop next
end)
(* cek-run *)
and cek_run state =
@@ -613,6 +631,11 @@ and cek_resume suspended_state result' =
(* cek-step *)
and cek_step state =
if !step_limit > 0 then begin
step_count := !step_count + 1;
if !step_count > !step_limit then
raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (cek_step)")
end;
(if sx_truthy ((prim_call "=" [(cek_phase (state)); (String "eval")])) then (step_eval (state)) else (step_continue (state)))
(* step-eval *)