From 4856a63c11dbebbc8811ffc961f993e23520fabd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 8 Jan 2025 13:37:28 +0100 Subject: [PATCH] erlc: Send warnings and errors to stderr `erlc` used to send all output to stdout, in contrast to other language compilers such as `gcc` and `clang`, which send diagnostics to stderr. Fixes #9255 --- erts/etc/common/erlc.c | 38 ++++++++----- erts/test/erlc_SUITE.erl | 81 ++++++++++++++++++--------- lib/kernel/src/erl_compile_server.erl | 33 +++++++---- lib/stdlib/src/erl_compile.erl | 55 +++++++++++++----- 4 files changed, 137 insertions(+), 70 deletions(-) diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index d376cd89755d..42fefd950d3b 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -771,32 +771,40 @@ call_compile_server(char** argv) if (dec_size >= 2) { ei_decode_atom(reply.buff, &dec_index, atom); } - if (dec_size == 2) { - if (strcmp(atom, "ok") == 0) { - char* output = decode_binary(reply.buff, &dec_index, &dec_size); - if (debug) { - fprintf(stderr, "called server for %s => ok\n", source_file); - } - if (output) { - fwrite(output, dec_size, 1, stdout); - exit(0); - } + if (dec_size == 2 && strcmp(atom, "ok") == 0) { + /* An old compile server from OTP 27 or earlier. */ + char* output = decode_binary(reply.buff, &dec_index, &dec_size); + if (debug) { + fprintf(stderr, "called server for %s => ok\n", source_file); + } + if (output) { + fwrite(output, dec_size, 1, stdout); + exit(0); } - } else if (dec_size == 3 && strcmp(atom, "error") == 0) { + } else if (dec_size == 3 && (strcmp(atom, "ok") || + strcmp(atom, "error"))) { + /* A compile server from OTP 28 or later. */ int std_size, err_size; char* std; char* err; + int exit_status = atom[0] == 'e'; if (debug) { - fprintf(stderr, "called server for %s => error\n", source_file); + if (exit_status) { + fprintf(stderr, "called server for %s => error\n", source_file); + } else { + fprintf(stderr, "called server for %s => ok\n", source_file); + } } std = decode_binary(reply.buff, &dec_index, &std_size); err = decode_binary(reply.buff, &dec_index, &err_size); - if (std && err) { - fwrite(err, err_size, 1, stderr); + if (std) { fwrite(std, std_size, 1, stdout); - exit(1); } + if (err) { + fwrite(err, err_size, 1, stderr); + } + exit(exit_status); } } diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index c6f3a2bf310a..a44ba4881dd0 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -128,8 +128,8 @@ compile_erl(Config) when is_list(Config) -> FileName = filename:join(SrcDir, "erl_test_ok.erl"), %% By default, warnings are now turned on. - run(Config, Cmd, FileName, "", - ["Warning: function foo/0 is unused\$", "_OK_"]), + run_stderr(Config, Cmd, FileName, "", + ["Warning: function foo/0 is unused\$", "_OK_"]), %% Test that the compiled file is where it should be, %% and that it is runnable. @@ -144,15 +144,16 @@ compile_erl(Config) when is_list(Config) -> %% Try treating warnings as errors. - run(Config, Cmd, FileName, "-Werror", - ["compile: warnings being treated as errors\$", - "function foo/0 is unused\$", "_ERROR_"]), + run_stderr(Config, Cmd, FileName, "-Werror", + ["compile: warnings being treated as errors\$", + "function foo/0 is unused\$", "_ERROR_"]), %% Check a bad file. BadFile = filename:join(SrcDir, "erl_test_bad.erl"), - run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", - "_ERROR_"]), + run_stderr(Config, Cmd, BadFile, "", + ["function non_existing/1 undefined\$", + "_ERROR_"]), ok. %% Test that compiling yecc source code works. @@ -165,11 +166,11 @@ compile_yecc(Config) when is_list(Config) -> true = exists(filename:join(OutDir, "yecc_test_ok.erl")), BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), - run(Config, Cmd, BadFile, "-W0", - ["Nonterminals is missing\$", - "rootsymbol form is not a nonterminal\$", - "undefined nonterminal: form\$", - "_ERROR_"]), + run_stderr(Config, Cmd, BadFile, "-W0", + ["Nonterminals is missing\$", + "rootsymbol form is not a nonterminal\$", + "undefined nonterminal: form\$", + "_ERROR_"]), exists(filename:join(OutDir, "yecc_test_ok.erl")), ok. @@ -182,7 +183,7 @@ compile_script(Config) when is_list(Config) -> true = exists(filename:join(OutDir, "start_ok.boot")), BadFile = filename:join(SrcDir, "start_bad.script"), - run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), + run_stderr(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), ok. %% Test that compiling SNMP mibs works. @@ -206,9 +207,9 @@ compile_mib(Config) when is_list(Config) -> ok = file:delete(Output), case os:type() of {unix,_} -> - run(Config, Cmd, FileName, "-W +'{verbosity,info}'", - ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", - "_OK_"]), + run_stderr(Config, Cmd, FileName, "-W +'{verbosity,info}'", + ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", + "_OK_"]), true = exists(Output), ok = file:delete(Output); _ -> ok %Don't bother -- too much work. @@ -217,9 +218,9 @@ compile_mib(Config) when is_list(Config) -> %% Try a bad file. BadFile = filename:join(SrcDir, "BAD-MIB.mib"), - run(Config, Cmd, BadFile, "", - ["BAD-MIB.mib: 1: syntax error before: mibs\$", - "compilation_failed_ERROR_"]), + run_stderr(Config, Cmd, BadFile, "", + ["BAD-MIB.mib: 1: syntax error before: mibs\$", + "compilation_failed_ERROR_"]), %% Make sure that no -I option works. @@ -373,7 +374,7 @@ make_dep_options(Config) -> false = exists(BeamFileName), %% Test -M -MT Target - run(Config, Cmd, FileName, "-M -MT target", DepRETarget), + run_stdout(Config, Cmd, FileName, "-M -MT target", DepRETarget), false = exists(BeamFileName), %% Test -MF File -MT Target @@ -395,16 +396,16 @@ make_dep_options(Config) -> %% Test -M -MQ Target. (Note: Passing a $ on the command line %% portably for Unix and Windows is tricky, so we will just test %% that MQ works at all.) - run(Config, Cmd, FileName, "-M -MQ target", DepRETarget), + run_stdout(Config, Cmd, FileName, "-M -MQ target", DepRETarget), false = exists(BeamFileName), %% Test -M -MP - run(Config, Cmd, FileName, "-M -MP", DepREMP), + run_stdout(Config, Cmd, FileName, "-M -MP", DepREMP), false = exists(BeamFileName), %% Test -M -MG MissingHeader = filename:join(SrcDir, "erl_test_missing_header.erl"), - run(Config, Cmd, MissingHeader, "-M -MG", DepREMissing), + run_stdout(Config, Cmd, MissingHeader, "-M -MG", DepREMissing), false = exists(BeamFileName), %% @@ -428,7 +429,7 @@ make_dep_options(Config) -> %% Test plain -MMD -M - run(Config, Cmd, FileName, "-MMD -M", DepRE_MMD), + run_stdout(Config, Cmd, FileName, "-MMD -M", DepRE_MMD), true = exists(BeamFileName), file:delete(BeamFileName), @@ -449,7 +450,7 @@ make_dep_options(Config) -> file:delete(BeamFileName), %% Test -MMD -M -MT Target - run(Config, Cmd, FileName, "-MMD -M -MT target", DepRETarget_MMD), + run_stdout(Config, Cmd, FileName, "-MMD -M -MT target", DepRETarget_MMD), true = exists(BeamFileName), file:delete(BeamFileName), @@ -474,18 +475,18 @@ make_dep_options(Config) -> %% Test -MMD -M -MQ Target. (Note: Passing a $ on the command line %% portably for Unix and Windows is tricky, so we will just test %% that MQ works at all.) - run(Config, Cmd, FileName, "-MMD -M -MQ target", DepRETarget_MMD), + run_stdout(Config, Cmd, FileName, "-MMD -M -MQ target", DepRETarget_MMD), true = exists(BeamFileName), file:delete(BeamFileName), %% Test -MMD -M -MP - run(Config, Cmd, FileName, "-MMD -M -MP", DepREMP_MMD), + run_stdout(Config, Cmd, FileName, "-MMD -M -MP", DepREMP_MMD), true = exists(BeamFileName), file:delete(BeamFileName), %% Test -MMD -M -MG MissingHeader = filename:join(SrcDir, "erl_test_missing_header.erl"), - run(Config, Cmd, MissingHeader, "-MMD -M -MG", DepREMissing_MMD), + run_stdout(Config, Cmd, MissingHeader, "-MMD -M -MG", DepREMissing_MMD), false = exists(BeamFileName), ok. @@ -1081,6 +1082,30 @@ features_include(Config) when is_list(Config) -> %% Runs a command. +run_stdout(Config, Cmd0, Name, Options, Expect) -> + case os:type() of + {unix,_} -> + %% The output is expected to be printed to stdout. + Cmd = Cmd0 ++ " " ++ Options ++ " " ++ Name ++ " 2>/dev/null", + io:format("~ts", [Cmd]), + Result = run_command(Config, Cmd), + verify_result(Result, Expect); + _ -> + run(Config, Cmd0, Name, Options, Expect) + end. + +run_stderr(Config, Cmd0, Name, Options, Expect) -> + case os:type() of + {unix,_} -> + %% The output is expected to be printed to stderr. + Cmd = Cmd0 ++ " " ++ Options ++ " " ++ Name ++ " >/dev/null", + io:format("~ts", [Cmd]), + Result = run_command(Config, Cmd), + verify_result(Result, Expect); + _ -> + run(Config, Cmd0, Name, Options, Expect) + end. + run(Config, Cmd0, Name, Options, Expect) -> Cmd = Cmd0 ++ " " ++ Options ++ " " ++ Name, io:format("~ts", [Cmd]), diff --git a/lib/kernel/src/erl_compile_server.erl b/lib/kernel/src/erl_compile_server.erl index d946b630a6a8..244ed375a175 100644 --- a/lib/kernel/src/erl_compile_server.erl +++ b/lib/kernel/src/erl_compile_server.erl @@ -136,13 +136,20 @@ do_compile(ErlcArgs, Cwd, Enc) -> GL = create_gl(), group_leader(GL, self()), Result = erl_compile:compile(ErlcArgs, Cwd), - StdOutput = ensure_enc(gl_get_output(GL), Enc), - case Result of - ok -> - {ok, StdOutput}; - {error, StdErrorOutput0} -> + {OutputChannel,Output0} = gl_get_output(GL), + Output = ensure_enc(Output0, Enc), + case {Result,OutputChannel} of + {ok, standard_error} -> + {ok, ~"", Output}; + {ok, standard_io} -> + {ok, Output, ~""}; + {{error,StdErrorOutput0}, standard_error} -> + StdErrorOutput1 = ensure_enc(StdErrorOutput0, Enc), + StdErrorOutput = <>, + {error, ~"", StdErrorOutput}; + {{error,StdErrorOutput0}, standard_io} -> StdErrorOutput = ensure_enc(StdErrorOutput0, Enc), - {error, StdOutput, StdErrorOutput} + {error, Output, StdErrorOutput} end. parse_command_line(#{command_line := CmdLine0, cwd := Cwd, encoding := Enc}) -> @@ -207,7 +214,7 @@ make_config(PathArgs, Env0) -> %%% create_gl() -> - spawn_link(fun() -> gl_loop([]) end). + spawn_link(fun() -> gl_loop([], standard_error) end). gl_get_output(GL) -> GL ! {self(), get_output}, @@ -215,18 +222,20 @@ gl_get_output(GL) -> {GL, Output} -> Output end. -gl_loop(State0) -> +gl_loop(State0, OutputChannel) -> receive {io_request, From, ReplyAs, Request} -> {_Tag, Reply, State} = gl_request(Request, State0), gl_reply(From, ReplyAs, Reply), - gl_loop(State); + gl_loop(State, OutputChannel); {From, get_output} -> Output = iolist_to_binary(State0), - From ! {self(), Output}, - gl_loop(State0); + From ! {self(), {OutputChannel, Output}}, + gl_loop(State0, OutputChannel); + {erl_compile_server, standard_io} -> + gl_loop(State0, standard_io); _Unknown -> - gl_loop(State0) + gl_loop(State0, OutputChannel) end. gl_reply(From, ReplyAs, Reply) -> diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index 8eddf2f1f149..ca8cd4995e64 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -55,20 +55,20 @@ compile_cmdline() -> -spec compile(list(), file:filename()) -> 'ok' | {'error', binary()} | {'crash', {atom(), term(), term()}}. compile(Args, Cwd) -> - try compile1(Args, #options{outdir=Cwd,cwd=Cwd}) of - ok -> - ok - catch - throw:{error, Output} -> - {error, unicode:characters_to_binary(Output)}; - C:E:Stk -> - {crash, {C,E,Stk}} - end. + put(compile_server, true), + do_compile(Args, Cwd). %% Run the the compiler in a separate process. compile_cmdline1(Args) -> {ok, Cwd} = file:get_cwd(), - {Pid,Ref} = spawn_monitor(fun() -> exit(compile(Args, Cwd)) end), + F = fun() -> + put(compile_server, false), + put(standard_io, group_leader()), + StdError = whereis(standard_error), + group_leader(StdError, self()), + exit(do_compile(Args, Cwd)) + end, + {Pid,Ref} = spawn_monitor(F), receive {'DOWN', Ref, process, Pid, Result} -> case Result of @@ -91,6 +91,17 @@ cmdline_init() -> true = code:set_path(Path), ok. +do_compile(Args, Cwd) -> + try compile1(Args, #options{outdir=Cwd,cwd=Cwd}) of + ok -> + ok + catch + throw:{error, Output} -> + {error, unicode:characters_to_binary(Output)}; + C:E:Stk -> + {crash, {C,E,Stk}} + end. + %% Parse all options. compile1(["--"|Files], Opts) -> compile2(Files, Opts); @@ -291,16 +302,30 @@ compile2(Files, #options{cwd=Cwd,includes=Incl,outfile=Outfile}=Opts0) -> Opts = Opts0#options{includes=lists:reverse(Incl)}, case {Outfile,length(Files)} of {"", _} -> - compile3(Files, Cwd, Opts); + compile_files(Files, Cwd, Opts); {[_|_], 1} -> - compile3(Files, Cwd, Opts); + compile_files(Files, Cwd, Opts); {[_|_], _N} -> throw({error, "Output file name given, but more than one input file.\n"}) end end. +compile_files(Files, Cwd, #options{specific=Specific}=Opts) -> + Stdout = lists:member({makedep_output,standard_io}, Specific), + case {Stdout,get(compile_server)} of + {true,true} -> + group_leader() ! {erl_compile_server, standard_io}, + ok; + {true,false} -> + group_leader(get(standard_io), self()), + ok; + {false,_} -> + ok + end, + do_compile_files(Files, Cwd, Opts). + %% Compile the list of files, until done or compilation fails. -compile3([File|Rest], Cwd, Options) -> +do_compile_files([File|Rest], Cwd, Options) -> Ext = filename:extension(File), Root = filename:rootname(File), InFile = filename:absname(Root, Cwd), @@ -312,8 +337,8 @@ compile3([File|Rest], Cwd, Options) -> filename:rootname(Outfile) end, compile_file(Ext, InFile, OutFile, Options), - compile3(Rest, Cwd, Options); -compile3([], _Cwd, _Options) -> ok. + do_compile_files(Rest, Cwd, Options); +do_compile_files([], _Cwd, _Options) -> ok. show_info(#options{specific = Spec}) -> G = fun G0([]) -> undefined;