JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The nested-overflow test waits for the outer break to be on top instead of sleeping, and names a session that dies

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 13:56:11 +07:00
parent 8bb2885e63
commit 9373c43113
1 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
test/test_dev.ml
View File

@ -7854,10 +7854,23 @@ let () =
(* A runaway recursion evaluated in the break loop of a fault: the (* A runaway recursion evaluated in the break loop of a fault: the
loop runs on a stack of its own with a guard page, so the second loop runs on a stack of its own with a guard page, so the second
overflow is a second break, and both abort. *) overflow is a second break, and both abort. *)
(try
ignore (eval_expr "(deep 0)"); ignore (eval_expr "(deep 0)");
if not (stopped ()) then fail "the first overflow (%s) did not stop" shape if not (stopped ()) then fail "the first overflow (%s) did not stop" shape
else begin else begin
ignore (eval_expr "(deep 0)"); ignore (eval_expr "(deep 0)");
(* How many restarts the stopped break lists, which is what tells
the inner break from the outer — both are SegFault. The inner
one lists its own evaluation's boundary and, below it, the
outer one's. *)
let listed () =
match Wire.field (request tc "(:op \"break\")") "restarts" with
| Some { Form.v = Form.List l; _ } -> List.length l
| _ -> -1
in
let inner = listed () in
if inner < 2 then
fail "the nested overflow (%s) listed %d restarts" shape inner;
(match request tc "(:op \"abort\")" with (match request tc "(:op \"abort\")" with
| r when status r = "ok" -> () | r when status r = "ok" -> ()
| r -> fail "aborting a nested overflow (%s): %s" shape (said r) | r -> fail "aborting a nested overflow (%s): %s" shape (said r)
@ -7865,11 +7878,16 @@ let () =
fail "a nested overflow (%s) ended the session: %s" shape fail "a nested overflow (%s) ended the session: %s" shape
(Printexc.to_string e)); (Printexc.to_string e));
(* The inner break unwinds on the program's thread; the second (* The inner break unwinds on the program's thread; the second
abort is for the outer one, so it waits for that. *) abort is for the outer one, so it waits until the break on top
Unix.sleepf 0.5; is the outer one. *)
if not (await ~ms:30000 (fun () -> let d = listed () in d > 0 && d < inner))
then fail "the inner overflow's break (%s) was never left" shape;
ignore (request tc "(:op \"abort\")"); ignore (request tc "(:op \"abort\")");
answers "(helper)" "1" "the session after a nested overflow" answers "(helper)" "1" "the session after a nested overflow"
end; end
with (Wire.Closed | Unix.Unix_error _) as e ->
fail "a nested overflow (%s) ended the session: %s" shape
(Printexc.to_string e));
(try (try
ignore (Wire.send tc "(:op \"close\")"); ignore (Wire.send tc "(:op \"close\")");
ignore (Wire.recv tc) ignore (Wire.recv tc)