瀏覽代碼

Add -D compilation_timeout

Rudy Ges 7 月之前
父節點
當前提交
5188593eb2
共有 2 個文件被更改,包括 24 次插入1 次删除
  1. 6 0
      src-json/define.json
  2. 18 1
      src/compiler/compiler.ml

+ 6 - 0
src-json/define.json

@@ -33,6 +33,12 @@
 		"define": "check-xml-proxy",
 		"define": "check-xml-proxy",
 		"doc": "Check the used fields of the 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",
 		"name": "CoreApi",
 		"define": "core-api",
 		"define": "core-api",

+ 18 - 1
src/compiler/compiler.ml

@@ -460,9 +460,24 @@ with
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->
 		error ctx (Printexc.to_string e) null_pos
 		error ctx (Printexc.to_string e) null_pos
 
 
+
 let compile_safe ctx f =
 let compile_safe ctx f =
 	try compile_safe ctx f with Abort -> ()
 	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 =
 let finalize ctx =
 	ctx.comm.flush ctx;
 	ctx.comm.flush ctx;
 	List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
 	List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
@@ -504,7 +519,9 @@ let compile_ctx callbacks ctx =
 		compile_safe ctx (fun () ->
 		compile_safe ctx (fun () ->
 			let actx = Args.parse_args ctx.com in
 			let actx = Args.parse_args ctx.com in
 			process_actx ctx actx;
 			process_actx ctx actx;
-			compile ctx actx callbacks;
+			compile_timeout ctx (fun () ->
+				compile ctx actx callbacks;
+			)
 		);
 		);
 		finalize ctx;
 		finalize ctx;
 		callbacks.after_compilation ctx;
 		callbacks.after_compilation ctx;