diff --git a/src/compiler/compilationContext.ml b/src/compiler/compilationContext.ml index 5065b5e4be1..65a664a152c 100644 --- a/src/compiler/compilationContext.ml +++ b/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; } diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 2b32ac175da..e22a34dff46 100644 --- a/src/compiler/compiler.ml +++ b/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 \ No newline at end of file diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 72233671ce8..891baf6bde3 100644 --- a/src/compiler/server.ml +++ b/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 diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index 1a08b936e29..e9cee38d488 100644 --- a/src/macro/eval/evalStdLib.ml +++ b/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)); ) diff --git a/tests/misc/compile.hxml b/tests/misc/compile.hxml index 665d17d2813..41d8c78bdbc 100644 --- a/tests/misc/compile.hxml +++ b/tests/misc/compile.hxml @@ -1,4 +1,4 @@ -p src -#-D MISC_TEST_FILTER=9619 +-D MISC_TEST_FILTER=sys-exit -main Main --interp \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/SysExit0.hx b/tests/misc/projects/sys-exit/SysExit0.hx new file mode 100644 index 00000000000..0c8e48ee818 --- /dev/null +++ b/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); + } +} \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/SysExit1.hx b/tests/misc/projects/sys-exit/SysExit1.hx new file mode 100644 index 00000000000..f447ffac85a --- /dev/null +++ b/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); + } +} \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile00.hxml b/tests/misc/projects/sys-exit/compile00.hxml new file mode 100644 index 00000000000..878356bec48 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile00.hxml @@ -0,0 +1,7 @@ +--main SysExit0 +--interp + +--next + +--main SysExit0 +--interp \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile00.hxml.stderr b/tests/misc/projects/sys-exit/compile00.hxml.stderr new file mode 100644 index 00000000000..da58f045b96 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile00.hxml.stderr @@ -0,0 +1,2 @@ +Exiting with 0 +Exiting with 0 \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile01-fail.hxml b/tests/misc/projects/sys-exit/compile01-fail.hxml new file mode 100644 index 00000000000..4478fb88803 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile01-fail.hxml @@ -0,0 +1,7 @@ +--main SysExit0 +--interp + +--next + +--main SysExit1 +--interp \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile01-fail.hxml.stderr b/tests/misc/projects/sys-exit/compile01-fail.hxml.stderr new file mode 100644 index 00000000000..59489da6164 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile01-fail.hxml.stderr @@ -0,0 +1,2 @@ +Exiting with 0 +Exiting with 1 \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile10-fail.hxml b/tests/misc/projects/sys-exit/compile10-fail.hxml new file mode 100644 index 00000000000..7398a5d6638 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile10-fail.hxml @@ -0,0 +1,7 @@ +--main SysExit1 +--interp + +--next + +--main SysExit0 +--interp \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile10-fail.hxml.stderr b/tests/misc/projects/sys-exit/compile10-fail.hxml.stderr new file mode 100644 index 00000000000..c916e2d5854 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile10-fail.hxml.stderr @@ -0,0 +1 @@ +Exiting with 1 \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile11-fail.hxml b/tests/misc/projects/sys-exit/compile11-fail.hxml new file mode 100644 index 00000000000..b40df28e624 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile11-fail.hxml @@ -0,0 +1,7 @@ +--main SysExit1 +--interp + +--next + +--main SysExit1 +--interp \ No newline at end of file diff --git a/tests/misc/projects/sys-exit/compile11-fail.hxml.stderr b/tests/misc/projects/sys-exit/compile11-fail.hxml.stderr new file mode 100644 index 00000000000..c916e2d5854 --- /dev/null +++ b/tests/misc/projects/sys-exit/compile11-fail.hxml.stderr @@ -0,0 +1 @@ +Exiting with 1 \ No newline at end of file