1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(erl_error).
21
22-export([format_exception/6, format_exception/7, format_exception/8,
23         format_stacktrace/4, format_stacktrace/5,
24         format_call/4, format_call/5, format_fun/1, format_fun/2]).
25
26%%% Formatting of exceptions, mfa:s and funs.
27
28%% -> iolist() (no \n at end)
29%% I is the current column, starting from 1 (it will be used
30%%   as indentation whenever newline has been inserted);
31%% Class, Reason and StackTrace are the exception;
32%% FormatFun = fun(Term, I) -> iolist() formats terms;
33%% StackFun = fun(Mod, Fun, Arity) -> boolean() is used for trimming the
34%%   end of the stack (typically calls to erl_eval are skipped).
35format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) ->
36    format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun,
37                     latin1).
38
39%% -> iolist() | unicode:charlist() (no \n at end)
40%% FormatFun = fun(Term, I) -> iolist() | unicode:charlist().
41format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding) ->
42    FF = wrap_format_fun_2(FormatFun),
43    format_exception(I, Class, Reason, StackTrace, StackFun, FF, Encoding, -1).
44
45format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding,
46                 CharsLimit)
47            when is_integer(I), I >= 1, is_function(StackFun, 3),
48                 is_function(FormatFun, 3), is_integer(CharsLimit) ->
49    S = n_spaces(I-1),
50    {Term,Trace1,Trace} = analyze_exception(Class, Reason, StackTrace),
51    StLimit = if
52                  CharsLimit < 0 ->
53                      CharsLimit;
54                  true ->
55                      %% Reserve one third for the stacktrace.
56                      CharsLimit div 3
57              end,
58    St = format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding, StLimit),
59    Lim = sub(sub(CharsLimit, exited(Class), latin1), St, Encoding),
60    Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding, Lim),
61    FormatString = case Encoding of
62                       latin1 -> "~s~s";
63                       _ -> "~s~ts"
64                   end,
65    Expl = io_lib:fwrite(FormatString, [exited(Class), Expl0]),
66    case St of
67        [] -> Expl;
68        _ -> [Expl, $\n, St]
69    end.
70
71%% -> iolist() (no \n at end)
72format_stacktrace(I, StackTrace, StackFun, FormatFun) ->
73    format_stacktrace(I, StackTrace, StackFun, FormatFun, latin1).
74
75%% -> iolist() | unicode:charlist()  (no \n at end)
76format_stacktrace(I, StackTrace, StackFun, FormatFun, Encoding)
77            when is_integer(I), I >= 1, is_function(StackFun, 3),
78                 is_function(FormatFun, 2) ->
79    S = n_spaces(I-1),
80    FF = wrap_format_fun_2(FormatFun),
81    format_stacktrace1(S, StackTrace, FF, StackFun, Encoding, -1).
82
83%% -> iolist() (no \n at end)
84format_call(I, ForMForFun, As, FormatFun) ->
85    format_call(I, ForMForFun, As, FormatFun, latin1).
86
87%% -> iolist() | unicode:charlist()  (no \n at end)
88format_call(I, ForMForFun, As, FormatFun, Enc)
89       when is_integer(I), I >= 1, is_list(As), is_function(FormatFun, 2) ->
90    FF = wrap_format_fun_2(FormatFun),
91    format_call("", n_spaces(I-1), ForMForFun, As, FF, Enc).
92
93%% -> iolist() (no \n at end)
94format_fun(Fun) ->
95    format_fun(Fun, latin1).
96
97%% -> iolist() (no \n at end)
98format_fun(Fun, Enc) when is_function(Fun) ->
99    {module, M} = erlang:fun_info(Fun, module),
100    {name, F} = erlang:fun_info(Fun, name),
101    {arity, A} = erlang:fun_info(Fun, arity),
102    case erlang:fun_info(Fun, type) of
103        {type, local} when F =:= "" ->
104            io_lib:fwrite(<<"~w">>, [Fun]);
105        {type, local} when M =:= erl_eval ->
106            io_lib:fwrite(<<"interpreted function with arity ~w">>, [A]);
107        {type, local} ->
108            mfa_to_string(M, F, A, Enc);
109        {type, external} ->
110            mfa_to_string(M, F, A, Enc)
111    end.
112
113wrap_format_fun_2(FormatFun) ->
114    fun(T, I1, CL) -> {FormatFun(T, I1), CL} end.
115
116analyze_exception(error, Term, Stack) ->
117    case {is_stacktrace(Stack), Stack, Term} of
118        {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) ->
119            {Term,[MFAL],MFAs};
120        {true, [{shell,F,A,_}], function_clause} when is_integer(A) ->
121            {Term, [{F,A}], []};
122        {true, [{_,_,_,_}=MFAL|MFAs], undef} ->
123            {Term,[MFAL],MFAs};
124	{true, _, _} ->
125	    {Term,[],Stack};
126	{false, _, _} ->
127	    {{Term,Stack},[],[]}
128    end;
129analyze_exception(_Class, Term, Stack) ->
130    case is_stacktrace(Stack) of
131        true ->
132            {Term,[],Stack};
133        false ->
134            {{Term,Stack},[],[]}
135    end.
136
137is_stacktrace([]) ->
138    true;
139is_stacktrace([{M,F,A,I}|Fs])
140  when is_atom(M), is_atom(F), is_integer(A), is_list(I) ->
141    is_stacktrace(Fs);
142is_stacktrace([{M,F,As,I}|Fs])
143  when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) ->
144    is_stacktrace(Fs);
145is_stacktrace(_) ->
146    false.
147
148%% ERTS exit codes (some of them are also returned by erl_eval):
149explain_reason(badarg, error, [], _PF, _S, _Enc, _CL) ->
150    <<"bad argument">>;
151explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc, CL) -> % orelse, andalso
152    format_value(V, <<"bad argument: ">>, Cl, PF, S, CL);
153explain_reason(badarith, error, [], _PF, _S, _Enc, _CL) ->
154    <<"an error occurred when evaluating an arithmetic expression">>;
155explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc, _CL)
156                                      when is_function(Fun) ->
157    %% Only the arity is displayed, not the arguments As.
158    io_lib:fwrite(<<"~ts called with ~s">>,
159                  [format_fun(Fun, Enc), argss(length(As))]);
160explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc, CL) ->
161    format_value(Term, <<"bad function ">>, Cl, PF, S, CL);
162explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc, CL) ->
163    Str = <<"no match of right hand side value ">>,
164    format_value(Term, Str, Cl, PF, S, CL);
165explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc, CL) ->
166    %% "there is no case clause with a true guard sequence and a
167    %% pattern matching..."
168    format_value(V, <<"no case clause matching ">>, Cl, PF, S, CL);
169explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc, _CL) ->
170    %% Shell commands
171    FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]),
172    [<<"no function clause matching call to ">> | FAs];
173explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc, CL) ->
174    Str = <<"no function clause matching ">>,
175    [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc, CL),$\s|location(Loc)];
176explain_reason(if_clause, error, [], _PF, _S, _Enc, _CL) ->
177    <<"no true branch found when evaluating an if expression">>;
178explain_reason(noproc, error, [], _PF, _S, _Enc, _CL) ->
179    <<"no such process or port">>;
180explain_reason(notalive, error, [], _PF, _S, _Enc, _CL) ->
181    <<"the node cannot be part of a distributed system">>;
182explain_reason(system_limit, error, [], _PF, _S, _Enc, _CL) ->
183    <<"a system limit has been reached">>;
184explain_reason(timeout_value, error, [], _PF, _S, _Enc, _CL) ->
185    <<"bad receive timeout value">>;
186explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc, CL) ->
187    %% "there is no try clause with a true guard sequence and a
188    %% pattern matching..."
189    format_value(V, <<"no try clause matching ">>, Cl, PF, S, CL);
190explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc, _CL) ->
191    %% Only the arity is displayed, not the arguments, if there are any.
192    io_lib:fwrite(<<"undefined function ~ts">>,
193                  [mfa_to_string(M, F, n_args(A), Enc)]);
194explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc, _CL) ->
195    %% Give nicer reports for undefined shell functions
196    %% (but not when the user actively calls shell_default:F(...)).
197    FS = to_string(F, Enc),
198    io_lib:fwrite(<<"undefined shell command ~ts/~w">>, [FS, n_args(A)]);
199%% Exit codes returned by erl_eval only:
200explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc, _CL) ->
201    io_lib:fwrite(<<"limit of number of arguments to interpreted function"
202                    " exceeded">>, []);
203explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc, CL) ->
204    format_value(V, <<"bad filter ">>, Cl, PF, S, CL);
205explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc, CL) ->
206    format_value(V, <<"bad generator ">>, Cl, PF, S, CL);
207explain_reason({unbound,V}, error, [], _PF, _S, _Enc, _CL) ->
208    io_lib:fwrite(<<"variable ~w is unbound">>, [V]);
209%% Exit codes local to the shell module (restricted shell):
210explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc, CL) ->
211    Str = <<"restricted shell module returned bad value ">>,
212    format_value(V, Str, Cl, PF, S, CL);
213explain_reason({restricted_shell_disallowed,{ForMF,As}},
214               exit=Cl, [], PF, S, Enc, CL) ->
215    %% ForMF can be a fun, but not a shell fun.
216    Str = <<"restricted shell does not allow ">>,
217    format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc, CL);
218explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc, _CL) ->
219    <<"restricted shell starts now">>;
220explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc, _CL) ->
221    <<"restricted shell stopped">>;
222%% Other exit code:
223explain_reason(Reason, Class, [], PF, S, _Enc, CL) ->
224    {L, _} = PF(Reason, (iolist_size(S)+1) + exited_size(Class), CL),
225    L.
226
227n_args(A) when is_integer(A) ->
228    A;
229n_args(As) when is_list(As) ->
230    length(As).
231
232argss(0) ->
233    <<"no arguments">>;
234argss(1) ->
235    <<"one argument">>;
236argss(2) ->
237    <<"two arguments">>;
238argss(I) ->
239    io_lib:fwrite(<<"~w arguments">>, [I]).
240
241format_stacktrace1(S0, Stack0, PF, SF, Enc, CL) ->
242    Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A)
243                             end, lists:reverse(Stack0)),
244    S = ["  " | S0],
245    Stack = lists:reverse(Stack1),
246    format_stacktrace2(S, Stack, 1, PF, Enc, CL).
247
248format_stacktrace2(_S, _Stack, _N, _PF, _Enc, _CL=0) ->
249    [];
250format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc, CL) when is_integer(A) ->
251    Cs = io_lib:fwrite(<<"~s~s ~ts ~ts">>,
252                       [sep(N, S), origin(N, M, F, A),
253                        mfa_to_string(M, F, A, Enc),
254                        location(L)]),
255    CL1 = sub(CL, Cs, Enc),
256    [Cs | format_stacktrace2(S, Fs, N + 1, PF, Enc, CL1)];
257format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc, CL) when is_list(As) ->
258    A = length(As),
259    CalledAs = [S,<<"   called as ">>],
260    C = format_call("", CalledAs, {M,F}, As, PF, Enc, CL),
261    Cs = io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>,
262                       [sep(N, S), origin(N, M, F, A),
263                        mfa_to_string(M, F, A, Enc),
264                        CalledAs, C]),
265    CL1 = sub(CL, Enc, Cs),
266    [Cs | format_stacktrace2(S, Fs, N + 1, PF, Enc, CL1)];
267format_stacktrace2(_S, [], _N, _PF, _Enc, _CL) ->
268    "".
269
270location(L) ->
271    File = proplists:get_value(file, L),
272    Line = proplists:get_value(line, L),
273    if
274	File =/= undefined, Line =/= undefined ->
275	    io_lib:format("(~ts, line ~w)", [File, Line]);
276	true ->
277	    ""
278    end.
279
280sep(1, S) -> S;
281sep(_, S) -> [$\n | S].
282
283origin(1, M, F, A) ->
284    case is_op({M, F}, n_args(A)) of
285        {yes, F} -> <<"in operator ">>;
286        no -> <<"in function ">>
287    end;
288origin(_N, _M, _F, _A) ->
289    <<"in call from">>.
290
291format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc, CL) ->
292    Pre1 = [Pre0 | n_spaces(exited_size(Class))],
293    format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, CL).
294
295format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) ->
296    format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, -1).
297
298format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, CL) ->
299    Arity = length(As),
300    [ErrStr |
301     case is_op(ForMForFun, Arity) of
302         {yes,Op} ->
303             format_op(ErrStr, Pre1, Op, As, PF, Enc, CL);
304         no ->
305             MFs = mf_to_string(ForMForFun, Arity, Enc),
306             I1 = string:length([Pre1,ErrStr|MFs]),
307             S1 = pp_arguments(PF, As, I1, Enc, CL),
308             S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc, CL),
309             S3 = pp_arguments(PF, [a2345,b2345], I1, Enc, CL),
310             Long = count_nl(S3) > 0,
311             case Long or (count_nl(S2) < count_nl(S1)) of
312                 true ->
313                     [$\n, Pre1, MFs, S2];
314                 false ->
315                     [MFs, S1]
316             end
317    end].
318
319format_op(ErrStr, Pre, Op, [A1], PF, _Enc, CL) ->
320    OpS = io_lib:fwrite(<<"~s ">>, [Op]),
321    I1 = iolist_size([ErrStr,Pre,OpS]),
322    {S, _} = PF(A1, I1+1, CL),
323    [OpS | S];
324format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc, CL) ->
325    I1 = iolist_size([ErrStr,Pre]),
326    {S1, CL1} = PF(A1, I1+1, CL),
327    {S2, _} = PF(A2, I1+1, CL1),
328    OpS = atom_to_list(Op),
329    Pre1 = [$\n | n_spaces(I1)],
330    case count_nl(S1) > 0 of
331        true ->
332            [S1,Pre1,OpS,Pre1|S2];
333        false ->
334            OpS2 = io_lib:fwrite(<<" ~s ">>, [Op]),
335            Size1 = iolist_size([ErrStr,Pre|OpS2]),
336            Size2 = size(Enc, S1),
337            {S2_2, _} = PF(A2, Size1+Size2+1, CL1),
338            case count_nl(S2) < count_nl(S2_2) of
339                true ->
340                    [S1,Pre1,OpS,Pre1|S2];
341                false ->
342                    [S1,OpS2|S2_2]
343            end
344    end.
345
346pp_arguments(PF, As, I, Enc, CL) ->
347    case {As, printable_list(Enc, As)} of
348        {[Int | T], true} ->
349            L = integer_to_list(Int),
350            Ll = length(L),
351            A = list_to_atom(lists:duplicate(Ll, $a)),
352            {S0, _} = PF([A | T], I+1, CL),
353            S = unicode:characters_to_list(S0, Enc),
354            brackets_to_parens([$[,L,string:slice(S, 1+Ll)], Enc);
355        _ ->
356            {S, _CL1} = PF(As, I+1, CL),
357            brackets_to_parens(S, Enc)
358    end.
359
360brackets_to_parens(S, Enc) ->
361    B = unicode:characters_to_binary(S, Enc),
362    Sz = byte_size(B) - 2,
363    <<$[,R:Sz/binary,$]>> = B,
364    [$(,R,$)].
365
366printable_list(latin1, As) ->
367    io_lib:printable_latin1_list(As);
368printable_list(_, As) ->
369    io_lib:printable_list(As).
370
371mfa_to_string(M, F, A, Enc) ->
372    io_lib:fwrite(<<"~ts/~w">>, [mf_to_string({M, F}, A, Enc), A]).
373
374mf_to_string({M, F}, A, Enc) ->
375    case erl_internal:bif(M, F, A) of
376        true ->
377            io_lib:fwrite(<<"~w">>, [F]);
378        false ->
379            case is_op({M, F}, A) of
380                {yes, '/'} ->
381                    io_lib:fwrite(<<"~w">>, [F]);
382                {yes, F} ->
383                    atom_to_list(F);
384                no ->
385                    FS = to_string(F, Enc),
386                    io_lib:fwrite(<<"~w:~ts">>, [M, FS])
387            end
388    end;
389mf_to_string(Fun, _A, Enc) when is_function(Fun) ->
390    format_fun(Fun, Enc);
391mf_to_string(F, _A, Enc) ->
392    FS = to_string(F, Enc),
393    io_lib:fwrite(<<"~ts">>, [FS]).
394
395format_value(V, ErrStr, Class, PF, S, CL) ->
396    Pre1Sz = exited_size(Class),
397    {S1, _} = PF(V, Pre1Sz + iolist_size([S, ErrStr]) + 1, CL),
398    [ErrStr | case count_nl(S1) of
399                  N1 when N1 > 1 ->
400                      {S2, _} = PF(V, iolist_size(S) + 1 + Pre1Sz, CL),
401                      case count_nl(S2) < N1 of
402                          true ->
403                              [$\n, S, n_spaces(Pre1Sz) | S2];
404                          false ->
405                              S1
406                      end;
407                  _ ->
408                      S1
409              end].
410
411%% Handles deep lists, but not all iolists.
412count_nl([E | Es]) ->
413    count_nl(E) + count_nl(Es);
414count_nl($\n) ->
415    1;
416count_nl(Bin) when is_binary(Bin) ->
417    count_nl(binary_to_list(Bin));
418count_nl(_) ->
419    0.
420
421n_spaces(N) ->
422    lists:duplicate(N, $\s).
423
424is_op(ForMForFun, A) ->
425    try
426        {erlang,F} = ForMForFun,
427        _ = erl_internal:op_type(F, A),
428        {yes,F}
429    catch error:_ -> no
430    end.
431
432exited_size(Class) ->
433    iolist_size(exited(Class)).
434
435exited(error) ->
436    <<"exception error: ">>;
437exited(exit) ->
438    <<"exception exit: ">>;
439exited(throw) ->
440    <<"exception throw: ">>.
441
442to_string(A, latin1) ->
443    io_lib:write_atom_as_latin1(A);
444to_string(A, _) ->
445    io_lib:write_atom(A).
446
447%% Make sure T does change sign.
448sub(T, _, _Enc) when T < 0 -> T;
449sub(T, S, Enc) ->
450    sub(T, size(Enc, S)).
451
452sub(T, Sz) when T >= Sz ->
453    T - Sz;
454sub(_T, _Sz) ->
455    0.
456
457size(latin1, S) ->
458    iolist_size(S);
459size(_, S) ->
460    string:length(S).
461