diff --git a/src-json/define.json b/src-json/define.json index 85559c57aed..9f216d7fb53 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -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", diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 73f4aae41a0..39e0f11af32 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -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; @@ -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;