Rework Sys.exit for eval (#10642)

* [eval] rework Sys.exit handling

* reduce diff

src/compiler/compilationContext.ml

@@ -30,6 +30,7 @@ type communication = {
 	write_out : string -> unit;
 	write_err : string -> unit;
 	flush     : compilation_context -> unit;
+	exit      : int -> unit;
 	is_server : bool;
 }
 

src/compiler/compiler.ml

@@ -692,10 +692,8 @@ with
 	| Parser.SyntaxCompletion(kind,subj) ->
 		DisplayOutput.handle_syntax_completion com kind subj;
 		error ctx ("Error: No completion point was found") null_pos
-	| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->
-		finalize ctx;
-		if !Timer.measure_times then Timer.report_times prerr_endline;
-		exit i
+	| EvalExceptions.Sys_exit _ | Hlinterp.Sys_exit _ as exc ->
+		raise exc
 	| DisplayException dex ->
 		handle_display_exception ctx dex
 	| Out_of_memory as exc ->
@@ -703,7 +701,22 @@ 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_ctx server_api comm ctx =
+let catch_completion_and_exit ctx server_api run =
+	try
+		run ctx;
+		if ctx.has_error then 1 else 0
+	with
+		| DisplayOutput.Completion str ->
+			server_api.after_compilation ctx;
+			ServerMessage.completion str;
+			ctx.comm.write_err str;
+			1
+		| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->
+			if i <> 0 then ctx.has_error <- true;
+			finalize ctx;
+			i
+
+let compile_ctx server_api ctx =
 	let run ctx =
 		server_api.before_anything ctx;
 		setup_common_context ctx;
@@ -732,23 +745,11 @@ let compile_ctx server_api comm ctx =
 		finalize ctx;
 		server_api.after_compilation ctx;
 	in
-	try
-		if ctx.has_error then begin
-			finalize ctx;
-			false (* can happen if process_params above fails already *)
-		end else begin
-			run ctx;
-			true (* reads as "continue?" *)
-		end
-	with
-		| DisplayOutput.Completion str ->
-			server_api.after_compilation ctx;
-			ServerMessage.completion str;
-			comm.write_err str;
-			false
-		| Arg.Bad msg ->
-			error ctx ("Error: " ^ msg) null_pos;
-			false
+	if ctx.has_error then begin
+		finalize ctx;
+		1 (* can happen if process_params fails already *)
+	end else
+		catch_completion_and_exit ctx server_api run
 
 let create_context comm cs compilation_step params = {
 	com = Common.create compilation_step cs version params;
@@ -819,9 +820,15 @@ module HighLevel = struct
 			error ctx ("Error: " ^ msg) null_pos;
 			[ctx]
 		in
-		let success = List.fold_left (fun b ctx -> b && compile_ctx server_api comm ctx) true ctxs in
-		if success then begin
+		let code = List.fold_left (fun code ctx ->
+			if code = 0 then
+				compile_ctx server_api ctx
+			else
+				code
+		) 0 ctxs in
+		if code = 0 then begin
 			Timer.close_times();
 			if !Timer.measure_times then Timer.report_times (fun s -> comm.write_err (s ^ "\n"));
 		end;
+		comm.exit code
 end

src/compiler/server.ml

@@ -186,8 +186,8 @@ module Communication = struct
 				ignore(read_line());
 			end;
 			flush stdout;
-			if has_error ctx then exit 1
 		);
+		exit = exit;
 		is_server = false;
 	}
 
@@ -215,6 +215,9 @@ module Communication = struct
 					maybe_cache_context sctx ctx.com;
 			)
 		);
+		exit = (fun i ->
+			()
+		);
 		is_server = true;
 	}
 end

src/macro/eval/evalStdLib.ml

@@ -2585,8 +2585,6 @@ module StdSys = struct
 	)
 
 	let exit = vfun1 (fun code ->
-		(* TODO: Borrowed from interp.ml *)
-		if (get_ctx()).curapi.use_cache() then raise (Error.Fatal_error ("",Globals.null_pos));
 		raise (Sys_exit(decode_int code));
 	)
 

tests/misc/compile.hxml

@@ -1,4 +1,4 @@
 -p src
-#-D MISC_TEST_FILTER=9619
+-D MISC_TEST_FILTER=sys-exit
 -main Main
 --interp

tests/misc/projects/sys-exit/SysExit0.hx

@@ -0,0 +1,6 @@
+class SysExit0 {
+	static function main() {
+		Sys.stderr().writeString("Exiting with 0\n");
+		Sys.exit(0);
+	}
+}

tests/misc/projects/sys-exit/SysExit1.hx

@@ -0,0 +1,6 @@
+class SysExit1 {
+	static function main() {
+		Sys.stderr().writeString("Exiting with 1\n");
+		Sys.exit(1);
+	}
+}

tests/misc/projects/sys-exit/compile00.hxml

@@ -0,0 +1,7 @@
+--main SysExit0
+--interp
+
+--next
+
+--main SysExit0
+--interp

tests/misc/projects/sys-exit/compile00.hxml.stderr

@@ -0,0 +1,2 @@
+Exiting with 0
+Exiting with 0

tests/misc/projects/sys-exit/compile01-fail.hxml

@@ -0,0 +1,7 @@
+--main SysExit0
+--interp
+
+--next
+
+--main SysExit1
+--interp

tests/misc/projects/sys-exit/compile01-fail.hxml.stderr

@@ -0,0 +1,2 @@
+Exiting with 0
+Exiting with 1

tests/misc/projects/sys-exit/compile10-fail.hxml

@@ -0,0 +1,7 @@
+--main SysExit1
+--interp
+
+--next
+
+--main SysExit0
+--interp

tests/misc/projects/sys-exit/compile10-fail.hxml.stderr

@@ -0,0 +1 @@
+Exiting with 1

tests/misc/projects/sys-exit/compile11-fail.hxml

@@ -0,0 +1,7 @@
+--main SysExit1
+--interp
+
+--next
+
+--main SysExit1
+--interp

tests/misc/projects/sys-exit/compile11-fail.hxml.stderr

@@ -0,0 +1 @@
+Exiting with 1