From 3eac5b869e2037b3c7196837f5ed41885dbde693 Mon Sep 17 00:00:00 2001 From: Fred Hebert Date: Sat, 8 Apr 2023 23:27:23 +0000 Subject: [PATCH 1/3] Attempt to support legible compiler error messages This is rather straightforward as an implementation: given any error message that contains column information, read the source file and find that line. Display it, and indent a cursor underneath it that points to the column. Then we can just show the same error message as before. In practice, given the module: -module(rebar_fake). -export([diagnostic/1]). diagnostic(A) -> X = add(5 / 0), {X,X}. add(X) -> X. add(X, Y) -> X + Y. Calling rebar3 compile yields: ... ===> Compiling rebar ===> Compiling apps/rebar/src/rebar_fake.erl failed apps/rebar/src/rebar_fake.erl:5:12: diagnostic(A) -> ^-- variable 'A' is unused apps/rebar/src/rebar_fake.erl:6:15: X = add(5 / 0), ^-- evaluation of operator '/'/2 will fail with a 'badarith' exception apps/rebar/src/rebar_fake.erl:11:1: add(X, Y) -> X + Y. ^-- function add/2 is unused This is friendlier than what we had before for sure. Adding color could be an extension to this if we find the format useful. The rebar compiler output richness is conditional and configurable, and we default to the minimal normal one to make sure it won't break all sorts of tooling. Rich errors also happen to support to xrl and yrl compilers --- apps/rebar/rebar.config | 1 + apps/rebar/src/rebar.hrl | 1 + apps/rebar/src/rebar_base_compiler.erl | 80 ++++++++++++++++++++------ apps/rebar/src/rebar_compiler.erl | 4 ++ apps/rebar/src/rebar_compiler_erl.erl | 2 +- apps/rebar/src/rebar_compiler_xrl.erl | 4 +- apps/rebar/src/rebar_compiler_yrl.erl | 4 +- rebar.config | 1 + rebar.config.sample | 3 + 9 files changed, 77 insertions(+), 23 deletions(-) diff --git a/apps/rebar/rebar.config b/apps/rebar/rebar.config index 157432570..2d23451c6 100644 --- a/apps/rebar/rebar.config +++ b/apps/rebar/rebar.config @@ -88,3 +88,4 @@ ]} ]}. +{compiler_error_format, rich}. diff --git a/apps/rebar/src/rebar.hrl b/apps/rebar/src/rebar.hrl index 3931620f6..fa6f2bda2 100644 --- a/apps/rebar/src/rebar.hrl +++ b/apps/rebar/src/rebar.hrl @@ -27,6 +27,7 @@ -define(DEFAULT_CDN, "https://repo.hex.pm"). -define(LOCK_FILE, "rebar.lock"). -define(DEFAULT_COMPILER_SOURCE_FORMAT, relative). +-define(DEFAULT_COMPILER_ERROR_FORMAT, minimal). % 'rich' for multiline values -define(PACKAGE_INDEX_VERSION, 6). -define(PACKAGE_TABLE, package_index). -define(INDEX_FILE, "packages.idx"). diff --git a/apps/rebar/src/rebar_base_compiler.erl b/apps/rebar/src/rebar_base_compiler.erl index 0a62d22f9..fd441065e 100644 --- a/apps/rebar/src/rebar_base_compiler.erl +++ b/apps/rebar/src/rebar_base_compiler.erl @@ -33,6 +33,7 @@ run/8, ok_tuple/2, error_tuple/4, + error_tuple/5, report/1, maybe_report/1, format_error_source/2]). @@ -139,8 +140,18 @@ ok_tuple(Source, Ws) -> Err :: string(), Warn :: string(). error_tuple(Source, Es, Ws, Opts) -> - {error, format_errors(Source, Es), - format_warnings(Source, Ws, Opts)}. + {error, format_errors(Source, Es, []), + format_warnings(Source, Ws, dict:new(), Opts)}. + +%% @doc format error and warning strings for a given source file +%% according to user preferences. +-spec error_tuple(file:filename(), [Err], [Warn], rebar_dict(), [{_,_}]) -> + error_tuple() when + Err :: string(), + Warn :: string(). +error_tuple(Source, Es, Ws, Config, Opts) -> + {error, format_errors(Source, Es, Config), + format_warnings(Source, Ws, Config, Opts)}. %% @doc from a given path, and based on the user-provided options, %% format the file path according to the preferences. @@ -208,19 +219,19 @@ compile_each([Source | Rest], Config, CompileFn) -> compile_each(Rest, Config, CompileFn). %% @private Formats and returns errors ready to be output. --spec format_errors(string(), [err_or_warn()]) -> [string()]. -format_errors(Source, Errors) -> - format_errors(Source, "", Errors). +-spec format_errors(string(), [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()]. +format_errors(Source, Errors, Opts) -> + format_errors(Source, "", Errors, Opts). %% @private Formats and returns warning strings ready to be output. -spec format_warnings(string(), [err_or_warn()]) -> [string()]. format_warnings(Source, Warnings) -> - format_warnings(Source, Warnings, []). + format_warnings(Source, Warnings, dict:new(), []). %% @private Formats and returns warnings; chooses the distinct format they %% may have based on whether `warnings_as_errors' option is on. --spec format_warnings(string(), [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()]. -format_warnings(Source, Warnings, Opts) -> +-spec format_warnings(string(), [err_or_warn()], rebar_dict(), rebar_dict() | [{_,_}]) -> [string()]. +format_warnings(Source, Warnings, Config, Opts) -> %% `Opts' can be passed in both as a list or a dictionary depending %% on whether the first call to rebar_erlc_compiler was done with %% the type `rebar_dict()' or `rebar_state:t()'. @@ -231,7 +242,7 @@ format_warnings(Source, Warnings, Opts) -> true -> ""; false -> "Warning: " end, - format_errors(Source, Prefix, Warnings). + format_errors(Source, Prefix, Warnings, Config). %% @private output compiler errors if they're judged to be reportable. -spec maybe_report(Reportable | term()) -> ok when @@ -254,16 +265,16 @@ report(Messages) -> lists:foreach(fun(Msg) -> io:format("~ts~n", [Msg]) end, Messages). %% private format compiler errors into proper outputtable strings --spec format_errors(_, Extra, [err_or_warn()]) -> [string()] when +-spec format_errors(_, Extra, [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()] when Extra :: string(). -format_errors(_MainSource, Extra, Errors) -> - [[format_error(Source, Extra, Desc) || Desc <- Descs] +format_errors(_MainSource, Extra, Errors, Opts) -> + [[format_error(Source, Extra, Desc, Opts) || Desc <- Descs] || {Source, Descs} <- Errors]. %% @private format compiler errors into proper outputtable strings --spec format_error(file:filename(), Extra, err_or_warn()) -> string() when +-spec format_error(file:filename(), Extra, err_or_warn(), rebar_dict() | [{_,_}]) -> string() when Extra :: string(). -format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}) -> +format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}, _Opts) -> %% Special case for include file errors, overtaking the default one BaseDesc = Mod:format_error(Desc), Friendly = case filename:split(File) of @@ -275,12 +286,45 @@ format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}) -> end, FriendlyDesc = BaseDesc ++ Friendly, ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, FriendlyDesc]); -format_error(Source, Extra, {{Line, Column}, Mod, Desc}) -> +format_error(Source, Extra, {{Line, Column}, Mod, Desc}, Opts) -> + CompilerErrFmt = compiler_error_format(Opts), + LineDesc = case find_line(Line, Source) of + {ok, LnBin} when CompilerErrFmt == rich -> + ?FMT("~n ~ts~n" + " ~s^--", [LnBin, lists:duplicate(max(0,Column-1), " ")]); + _ -> + "" + end, ErrorDesc = Mod:format_error(Desc), - ?FMT("~ts:~w:~w: ~ts~ts~n", [Source, Line, Column, Extra, ErrorDesc]); -format_error(Source, Extra, {Line, Mod, Desc}) -> + ?FMT("~ts:~w:~w:~ts ~ts~ts~n", [Source, Line, Column, LineDesc, + Extra, ErrorDesc]); +format_error(Source, Extra, {Line, Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, ErrorDesc]); -format_error(Source, Extra, {Mod, Desc}) -> +format_error(Source, Extra, {Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts: ~ts~ts~n", [Source, Extra, ErrorDesc]). + +compiler_error_format(Opts) -> + %% `Opts' can be passed in both as a list or a dictionary depending + %% on whether the first call to rebar_erlc_compiler was done with + %% the type `rebar_dict()' or `rebar_state:t()'. + LookupFn = if is_list(Opts) -> fun(K,L) -> lists:keyfind(K, 1, L) end + ; true -> fun(K,O) -> rebar_opts:get(O, K, false) end + end, + case LookupFn(compiler_error_format, Opts) of + false -> ?DEFAULT_COMPILER_ERROR_FORMAT; + {ok, minimal} -> minimal; + {ok, rich} -> rich; + minimal -> minimal; + rich -> rich + end. + +find_line(Nth, Source) -> + try + {ok, Bin} = file:read_file(Source), + Splits = re:split(Bin, "(?:\n|\r\n|\r)", [{newline, anycrlf}]), + {ok, lists:nth(Nth, Splits)} + catch + error:X -> {error, X} + end. diff --git a/apps/rebar/src/rebar_compiler.erl b/apps/rebar/src/rebar_compiler.erl index 39f1d3354..d4f7e38e2 100644 --- a/apps/rebar/src/rebar_compiler.erl +++ b/apps/rebar/src/rebar_compiler.erl @@ -9,6 +9,7 @@ needs_compile/3, ok_tuple/2, error_tuple/4, + error_tuple/5, maybe_report/1, format_error_source/2, report/1]). @@ -130,6 +131,9 @@ ok_tuple(Source, Ws) -> error_tuple(Source, Es, Ws, Opts) -> rebar_base_compiler:error_tuple(Source, Es, Ws, Opts). +error_tuple(Source, Es, Ws, Config, Opts) -> + rebar_base_compiler:error_tuple(Source, Es, Ws, Config, Opts). + maybe_report(Reportable) -> rebar_base_compiler:maybe_report(Reportable). diff --git a/apps/rebar/src/rebar_compiler_erl.erl b/apps/rebar/src/rebar_compiler_erl.erl index 6b4b52257..57bd685d8 100644 --- a/apps/rebar/src/rebar_compiler_erl.erl +++ b/apps/rebar/src/rebar_compiler_erl.erl @@ -183,7 +183,7 @@ clean(Files, AppInfo) -> error_tuple(Module, Es, Ws, AllOpts, Opts) -> FormattedEs = format_error_sources(Es, AllOpts), FormattedWs = format_error_sources(Ws, AllOpts), - rebar_compiler:error_tuple(Module, FormattedEs, FormattedWs, Opts). + rebar_compiler:error_tuple(Module, FormattedEs, FormattedWs, AllOpts, Opts). format_error_sources(Es, Opts) -> [{rebar_compiler:format_error_source(Src, Opts), Desc} diff --git a/apps/rebar/src/rebar_compiler_xrl.erl b/apps/rebar/src/rebar_compiler_xrl.erl index 35447ed13..3d3390cb1 100644 --- a/apps/rebar/src/rebar_compiler_xrl.erl +++ b/apps/rebar/src/rebar_compiler_xrl.erl @@ -34,14 +34,14 @@ needed_files(_, FoundFiles, Mappings, AppInfo) -> dependencies(_, _, _) -> []. -compile(Source, [{_, _}], _, Opts) -> +compile(Source, [{_, _}], Config, Opts) -> case leex:file(Source, [{return, true} | Opts]) of {ok, _} -> ok; {ok, _Mod, Ws} -> rebar_compiler:ok_tuple(Source, Ws); {error, Es, Ws} -> - rebar_compiler:error_tuple(Source, Es, Ws, Opts) + rebar_compiler:error_tuple(Source, Es, Ws, Config, Opts) end. clean(XrlFiles, _AppInfo) -> diff --git a/apps/rebar/src/rebar_compiler_yrl.erl b/apps/rebar/src/rebar_compiler_yrl.erl index c6392ae23..4692d480f 100644 --- a/apps/rebar/src/rebar_compiler_yrl.erl +++ b/apps/rebar/src/rebar_compiler_yrl.erl @@ -32,7 +32,7 @@ needed_files(_, FoundFiles, Mappings, AppInfo) -> dependencies(_, _, _) -> []. -compile(Source, [{_, OutDir}], _, Opts0) -> +compile(Source, [{_, OutDir}], Config, Opts0) -> Opts = case proplists:get_value(parserfile, Opts0) of undefined -> BaseName = filename:basename(Source, ".yrl"), @@ -48,7 +48,7 @@ compile(Source, [{_, OutDir}], _, Opts0) -> {ok, _Mod, Ws} -> rebar_compiler:ok_tuple(Source, Ws); {error, Es, Ws} -> - rebar_compiler:error_tuple(Source, Es, Ws, AllOpts) + rebar_compiler:error_tuple(Source, Es, Ws, Config, AllOpts) end. clean(YrlFiles, _AppInfo) -> diff --git a/rebar.config b/rebar.config index 72235d6a6..96a48b2ce 100644 --- a/rebar.config +++ b/rebar.config @@ -67,4 +67,5 @@ ]} ]}. +{compiler_error_format, rich}. %% The rest of the config is in apps/rebar/ diff --git a/rebar.config.sample b/rebar.config.sample index 77fef3804..c3646de26 100644 --- a/rebar.config.sample +++ b/rebar.config.sample @@ -27,6 +27,9 @@ {minimum_otp_vsn, "21.0"}. +%% Should errors be in a rich format, or a minimal one (tool-friendly) +{compiler_error_format, rich}. + %% MIB Options? {mib_opts, []}. %% SNMP mibs to compile first? From f07eba8cedb8cda945766484a3e58bc2006b9f6e Mon Sep 17 00:00:00 2001 From: Fred Hebert Date: Mon, 22 May 2023 15:50:13 +0000 Subject: [PATCH 2/3] Move the compiler rich error format code to a standalone module This will help testability and to better self-contain the implementation --- apps/rebar/src/rebar_base_compiler.erl | 34 +--------------- apps/rebar/src/rebar_compiler_format.erl | 49 ++++++++++++++++++++++++ 2 files changed, 50 insertions(+), 33 deletions(-) create mode 100644 apps/rebar/src/rebar_compiler_format.erl diff --git a/apps/rebar/src/rebar_base_compiler.erl b/apps/rebar/src/rebar_base_compiler.erl index fd441065e..e3f557990 100644 --- a/apps/rebar/src/rebar_base_compiler.erl +++ b/apps/rebar/src/rebar_base_compiler.erl @@ -287,17 +287,8 @@ format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}, _Opts) -> FriendlyDesc = BaseDesc ++ Friendly, ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, FriendlyDesc]); format_error(Source, Extra, {{Line, Column}, Mod, Desc}, Opts) -> - CompilerErrFmt = compiler_error_format(Opts), - LineDesc = case find_line(Line, Source) of - {ok, LnBin} when CompilerErrFmt == rich -> - ?FMT("~n ~ts~n" - " ~s^--", [LnBin, lists:duplicate(max(0,Column-1), " ")]); - _ -> - "" - end, ErrorDesc = Mod:format_error(Desc), - ?FMT("~ts:~w:~w:~ts ~ts~ts~n", [Source, Line, Column, LineDesc, - Extra, ErrorDesc]); + rebar_compiler_format:format(Source, {Line, Column}, Extra, ErrorDesc, Opts); format_error(Source, Extra, {Line, Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, ErrorDesc]); @@ -305,26 +296,3 @@ format_error(Source, Extra, {Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts: ~ts~ts~n", [Source, Extra, ErrorDesc]). -compiler_error_format(Opts) -> - %% `Opts' can be passed in both as a list or a dictionary depending - %% on whether the first call to rebar_erlc_compiler was done with - %% the type `rebar_dict()' or `rebar_state:t()'. - LookupFn = if is_list(Opts) -> fun(K,L) -> lists:keyfind(K, 1, L) end - ; true -> fun(K,O) -> rebar_opts:get(O, K, false) end - end, - case LookupFn(compiler_error_format, Opts) of - false -> ?DEFAULT_COMPILER_ERROR_FORMAT; - {ok, minimal} -> minimal; - {ok, rich} -> rich; - minimal -> minimal; - rich -> rich - end. - -find_line(Nth, Source) -> - try - {ok, Bin} = file:read_file(Source), - Splits = re:split(Bin, "(?:\n|\r\n|\r)", [{newline, anycrlf}]), - {ok, lists:nth(Nth, Splits)} - catch - error:X -> {error, X} - end. diff --git a/apps/rebar/src/rebar_compiler_format.erl b/apps/rebar/src/rebar_compiler_format.erl new file mode 100644 index 000000000..d79cc503b --- /dev/null +++ b/apps/rebar/src/rebar_compiler_format.erl @@ -0,0 +1,49 @@ +%%% @doc Module handling rich formatting of errors. +-module(rebar_compiler_format). +-export([format/5]). + +-include("rebar.hrl"). + +-spec format(file:filename_all(), {Line, Column}, Extra, Desc, rebar_dict()) -> + string() when + Extra :: iodata(), + Line :: non_neg_integer(), + Column :: non_neg_integer(), + Desc :: iodata(). +format(Source, {Line, Column}, Extra, Desc, Config) -> + CompilerErrFmt = compiler_error_format(Config), + case CompilerErrFmt == rich andalso find_line(Line, Source) of + {ok, LnBin} -> + ?FMT("~ts: ~w:~w:~n" + " ~ts~n" + " ~s^-- ~ts~ts~n", + [Source, Line, Column, + LnBin, + lists:duplicate(max(0, Column-1), " "), Extra, Desc]); + _ -> + ?FMT("~ts:~w:~w: ~ts~ts~n", [Source, Line, Column, Extra, Desc]) + end. + +find_line(Nth, Source) -> + try + {ok, Bin} = file:read_file(Source), + Splits = re:split(Bin, "(?:\n|\r\n|\r)", [{newline, anycrlf}]), + {ok, lists:nth(Nth, Splits)} + catch + error:X -> {error, X} + end. + +compiler_error_format(Opts) -> + %% `Opts' can be passed in both as a list or a dictionary depending + %% on whether the first call to rebar_erlc_compiler was done with + %% the type `rebar_dict()' or `rebar_state:t()'. + LookupFn = if is_list(Opts) -> fun(K,L) -> lists:keyfind(K, 1, L) end + ; true -> fun(K,O) -> rebar_opts:get(O, K, false) end + end, + case LookupFn(compiler_error_format, Opts) of + false -> ?DEFAULT_COMPILER_ERROR_FORMAT; + {ok, minimal} -> minimal; + {ok, rich} -> rich; + minimal -> minimal; + rich -> rich + end. From dbbb73aef6edf76b1abc2a0696b4244aabb0ce45 Mon Sep 17 00:00:00 2001 From: Fred Hebert Date: Mon, 22 May 2023 17:09:50 +0000 Subject: [PATCH 3/3] Richer and colorized compiler output MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This now looks like: ... ===> Compiling apps/rebar/src/fake_mod.erl failed ┌─ apps/rebar/src/fake_mod.erl: │ 5 │ diagnostic(A) -> │ ╰── variable 'A' is unused ┌─ apps/rebar/src/fake_mod.erl: │ 6 │ X = add(5 / 0), │ ╰── evaluation of operator '/'/2 will fail with a 'badarith' exception ┌─ apps/rebar/src/fake_mod.erl: │ 11 │ add(X, Y) -> X + Y. │ ╰── function add/2 is unused And supports colors with a weak heuristic based on regexes that I expect we'll need to fix and expand later to cover more compiler-specific rules. --- apps/rebar/src/rebar_compiler_format.erl | 35 +++++-- .../test/rebar_compiler_format_SUITE.erl | 94 +++++++++++++++++++ 2 files changed, 123 insertions(+), 6 deletions(-) create mode 100644 apps/rebar/test/rebar_compiler_format_SUITE.erl diff --git a/apps/rebar/src/rebar_compiler_format.erl b/apps/rebar/src/rebar_compiler_format.erl index d79cc503b..a8992a67b 100644 --- a/apps/rebar/src/rebar_compiler_format.erl +++ b/apps/rebar/src/rebar_compiler_format.erl @@ -14,12 +14,16 @@ format(Source, {Line, Column}, Extra, Desc, Config) -> CompilerErrFmt = compiler_error_format(Config), case CompilerErrFmt == rich andalso find_line(Line, Source) of {ok, LnBin} -> - ?FMT("~ts: ~w:~w:~n" - " ~ts~n" - " ~s^-- ~ts~ts~n", - [Source, Line, Column, - LnBin, - lists:duplicate(max(0, Column-1), " "), Extra, Desc]); + LnPad = lists:duplicate(length(integer_to_list(Line)), " "), + Arrow = cf:format("~!R~ts~!!",["╰──"]), + ?FMT(" ~ts ┌─ ~ts:~n" + " ~ts │~n" + " ~w │ ~ts~n" + " ~ts │ ~s~ts ~ts~ts~n~n", + [LnPad, Source, + LnPad, + Line, colorize(LnBin, Column), + LnPad, lists:duplicate(max(0, Column-1), " "), Arrow, Extra, Desc]); _ -> ?FMT("~ts:~w:~w: ~ts~ts~n", [Source, Line, Column, Extra, Desc]) end. @@ -47,3 +51,22 @@ compiler_error_format(Opts) -> minimal -> minimal; rich -> rich end. + +%% @private try to colorize data based on common ways to end terminators +%% in Erlang-like languages. Any character that isn't one of the following +%% is considered to end a "word" of some type: +%% +%% - letters +%% - numbers +%% - underscore +%% - quotations +%% +%% This will have false positives in some cases and if that becomes annoying +%% we'll need to allow per-compiler module configurations here, but it should +%% generally lead to proper colorization. +colorize(Str, Col) -> + Pre = string:slice(Str, 0, max(0,Col-1)), + At = string:slice(Str, max(0,Col-1)), + [Bad | Tail] = [B || B <- re:split(At, "([^[A-Za-z0-9_#\"]+)", []), + B =/= <<>>], + cf:format("~ts~!R~ts~!!~ts", [Pre,Bad,Tail]). diff --git a/apps/rebar/test/rebar_compiler_format_SUITE.erl b/apps/rebar/test/rebar_compiler_format_SUITE.erl new file mode 100644 index 000000000..e35f5b888 --- /dev/null +++ b/apps/rebar/test/rebar_compiler_format_SUITE.erl @@ -0,0 +1,94 @@ +-module(rebar_compiler_format_SUITE). +-compile([export_all, nowarn_export_all]). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). + +-define(EOL, lists:flatten(io_lib:format("~n",[]))). + +all() -> + [minimal, nocolor]. + +init_per_testcase(minimal, Config) -> + Conf = dict:from_list([{compiler_error_format, minimal}]), + [{conf, Conf} | init_per_testcase(regular, Config)]; +init_per_testcase(_, Config) -> + OriginalTerm = os:getenv("TERM"), + os:putenv("TERM", "dumb"), % disable color + application:set_env(cf, colour_term, cf_term:has_color("dumb")), + FileName = filename:join(?config(priv_dir, Config), "oracle.erl"), + ok = file:write_file(FileName, oracle()), + Conf = dict:from_list([{compiler_error_format, rich}]), + [{conf, Conf}, {file, FileName}, {term, OriginalTerm} | Config]. + +end_per_testcase(_, Config) -> + case ?config(term, Config) of + false -> + os:unsetenv("TERM"), + application:unset_env(cf, colour_term); + Original -> + os:putenv("TERM", Original), + application:set_env(cf, colour_term, cf_term:has_color("Original")) + end, + Config. + +oracle() -> + "-module(noline_end);\n" + ++ lists:duplicate(9, $\n) ++ + "first character on line 11.\n" + ++ lists:duplicate(99, $\n) ++ + "case X of ^whatever % on line 111\n". + +minimal() -> + [{doc, "showing minimal (default) output"}]. +minimal(Config) -> + Path = ?config(file, Config), + Conf = ?config(conf, Config), + ?assertEqual(Path++":1:20: => unexpected token: ;"++?EOL, + rebar_compiler_format:format(Path, {1,20}, "=> ", "unexpected token: ;", Conf)), + ?assertEqual(Path++":11:1: some message"++?EOL, + rebar_compiler_format:format(Path, {11,1}, "", "some message", Conf)), + ?assertEqual(Path++":111:11: the character '^' is not expected here."++?EOL, + rebar_compiler_format:format(Path, {111,11}, "", "the character '^' is not expected here.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":855:1: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {855,1}, "", "invalid ranges.", Conf)), + ?assertEqual("/very/fake/path.oof:1:1: unknown file."++?EOL, + rebar_compiler_format:format("/very/fake/path.oof", {1,1}, "", "unknown file.", Conf)), + ok. + + +nocolor() -> + [{doc, "testing all sorts of planned output"}]. +nocolor(Config) -> + Path = ?config(file, Config), + Conf = ?config(conf, Config), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 1 │ -module(noline_end);"++?EOL++ + " │ ╰── => unexpected token: ;"++?EOL++?EOL, + rebar_compiler_format:format(Path, {1,20}, "=> ", "unexpected token: ;", Conf)), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 11 │ first character on line 11."++?EOL++ + " │ ╰── some message"++?EOL++?EOL, + rebar_compiler_format:format(Path, {11,1}, "", "some message", Conf)), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 111 │ case X of ^whatever % on line 111"++?EOL++ + " │ ╰── the character '^' is not expected here."++?EOL++?EOL, + rebar_compiler_format:format(Path, {111,11}, "", "the character '^' is not expected here.", Conf)), + %% invalid cases fall back to minimal mode + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":855:1: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {855,1}, "", "invalid ranges.", Conf)), + ?assertEqual("/very/fake/path.oof:1:1: unknown file."++?EOL, + rebar_compiler_format:format("/very/fake/path.oof", {1,1}, "", "unknown file.", Conf)), + ok. +