Skip to content

Commit

Permalink
Add -D compilation_timeout
Browse files Browse the repository at this point in the history
  • Loading branch information
kLabz committed Feb 7, 2025
1 parent ff746a9 commit 5188593
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 1 deletion.
6 changes: 6 additions & 0 deletions src-json/define.json
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,12 @@
"define": "check-xml-proxy",
"doc": "Check the used fields of the XML proxy."
},
{
"name": "CompilationTimeout",
"define": "compilation-timeout",
"doc": "Abort compilation after [timeout] seconds.",
"params": ["timeout"]
},
{
"name": "CoreApi",
"define": "core-api",
Expand Down
19 changes: 18 additions & 1 deletion src/compiler/compiler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -460,9 +460,24 @@ with
| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->
error ctx (Printexc.to_string e) null_pos


let compile_safe ctx f =
try compile_safe ctx f with Abort -> ()

exception Timeout

let compile_timeout ctx f =
let _ =
Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout))
in
try
if defined ctx.com CompilationTimeout then (fun timeout -> ignore (Unix.alarm timeout)) (int_of_string (defined_value ctx.com CompilationTimeout));
f();
ignore(Unix.alarm 0)
with e ->
ignore(Unix.alarm 0);
raise e

let finalize ctx =
ctx.comm.flush ctx;
List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
Expand Down Expand Up @@ -504,7 +519,9 @@ let compile_ctx callbacks ctx =
compile_safe ctx (fun () ->
let actx = Args.parse_args ctx.com in
process_actx ctx actx;
compile ctx actx callbacks;
compile_timeout ctx (fun () ->
compile ctx actx callbacks;
)
);
finalize ctx;
callbacks.after_compilation ctx;
Expand Down

0 comments on commit 5188593

Please sign in to comment.