From f2e0e976382eddd3d120110c87882a2185e868aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 22 Mar 2011 05:23:09 +0100 Subject: Fix binary matching in the debugger 'eval_bits' is a common utility module used for evaluting binary construction and matching. The functions that do matching (match_bits/{6,7} and bin_gen/6) are supposed to treat the bindings as an abstract data type, but they assume that the bindings have the same representation as in the erl_eval module. That may cause binary matching to fail in the debugger, because the debugger represents the bindings as an unordered list of two-tuples, while the erl_eval modules uses an ordered list of two-tuple (an ordset). One way to fix the problem would be to let the debugger to use ordered lists to represent the bindings. Unfortunately, that would also change how the bindings are presented in the user interface. Currently, the variable have most been recently assigned is shown first, which is convenient. Fix the matching problem by mending the leaky abstraction in eval_bits. The matching functions needs to be passed two additional operations: one for looking up a variable in the bindings and one for adding a binding. Those operations could be passed as two more funs (in addition to the evaluation and match fun already passed), but the functions already have too many arguments. Therefore, change the meaning of the match fun, so that the first argument is the operation to perform ('match', 'binding', or 'add_binding') and second argument is a tuple with arguments for the operation. --- lib/stdlib/src/erl_eval.erl | 10 ++++++++-- lib/stdlib/src/eval_bits.erl | 47 +++++++++++++++++++++++--------------------- 2 files changed, 33 insertions(+), 24 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 515ea2ebb7..4f4fa16040 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -621,7 +621,7 @@ eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> erlang:raise(error, {bad_generator,Term}, stacktrace()). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, case eval_bits:bin_gen(P, Bin, new_bindings(), Bs0, Mfun, Efun) of {match, Rest, Bs1} -> @@ -1024,7 +1024,7 @@ match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, none, none, none) end); match1({bin,_,_}, _, _Bs, _BBs) -> throw(nomatch); @@ -1053,6 +1053,12 @@ match1({op,Line,Op,L,R}, Term, Bs, BBs) -> match1(_, _, _Bs, _BBs) -> throw(invalid). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 2cbd6cdae7..ddce4bd75a 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -31,8 +31,9 @@ %% @type evalfun(). A closure which evaluates an expression given an %% environment %% -%% @type matchfun(). A closure which performs a match given a value, a -%% pattern and an environment +%% @type matchfun(). A closure which depending on its first argument +%% can perform a match (given a value, a pattern and an environment), +%% lookup a variable in the bindings, or add a new binding %% %% @type field() represents a field in a "bin" @@ -144,7 +145,8 @@ eval_exp_field(Val, Size, Unit, binary, _, _) -> bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) -> bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true). -bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) -> +bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) + when is_function(Mfun, 2), is_function(Efun, 2) -> case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of {match,Bs,BBs,Rest} -> bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag); @@ -175,14 +177,14 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), - match_check_size(Size1, BBs0), + match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> NewV = coerce_to_float(V, Type), - case catch Mfun(NewV, Val, Bs0) of + case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> - BBs = add_bin_binding(NewV, Bs, BBs0), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {match,Bs,BBs,Rest}; _ -> {nomatch,Rest} @@ -205,7 +207,8 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) -> match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun). -match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) -> +match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) + when is_function(Mfun, 2), is_function(Efun, 2) -> case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of {match,Bs} -> {match,Bs}; invalid -> throw(invalid); @@ -230,12 +233,12 @@ match_field_1({bin_element,Line,VE,Size0,Options0}, make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Size2, BBs0), + match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), NewV = coerce_to_float(V, Type), - {match,Bs} = Mfun(NewV, Val, Bs0), - BBs = add_bin_binding(NewV, Bs, BBs0), + {match,Bs} = Mfun(match, {NewV,Val,Bs0}), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. %% Almost identical to the one in sys_pre_expand. @@ -249,12 +252,12 @@ coerce_to_float({integer,L,I}=E, float) -> coerce_to_float(E, _Type) -> E. -add_bin_binding({var,_,'_'}, _Bs, BBs) -> +add_bin_binding(_, {var,_,'_'}, _Bs, BBs) -> BBs; -add_bin_binding({var,_,Name}, Bs, BBs) -> - {value,Value} = erl_eval:binding(Name, Bs), - erl_eval:add_binding(Name, Value, BBs); -add_bin_binding(_, _Bs, BBs) -> +add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) -> + {value,Value} = Mfun(binding, {Name,Bs}), + Mfun(add_binding, {Name,Value,BBs}); +add_bin_binding(_, _, _Bs, BBs) -> BBs. get_value(Bin, integer, Size, Unit, Sign, Endian) -> @@ -327,20 +330,20 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {error,Reason} -> error(Reason) end. -match_check_size({var,_,V}, Bs) -> - case erl_eval:binding(V, Bs) of +match_check_size(Mfun, {var,_,V}, Bs) -> + case Mfun(binding, {V,Bs}) of {value,_} -> ok; unbound -> throw(invalid) % or, rather, error({unbound,V}) end; -match_check_size({atom,_,all}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs) -> ok; -match_check_size({atom,_,undefined}, _Bs) -> +match_check_size(_, {atom,_,undefined}, _Bs) -> ok; -match_check_size({integer,_,_}, _Bs) -> +match_check_size(_, {integer,_,_}, _Bs) -> ok; -match_check_size({value,_,_}, _Bs) -> +match_check_size(_, {value,_,_}, _Bs) -> ok; %From the debugger. -match_check_size(_, _Bs) -> +match_check_size(_, _, _Bs) -> throw(invalid). %% error(Reason) -> exception thrown -- cgit v1.2.3 From be04820c070d01d7565b936fa14efc2941055e0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Feb 2011 06:54:15 +0100 Subject: emulator: Add a fourth element in exception stacktraces This commit is a preparation for introducing location information (filename/line number) in stacktraces in exceptions. Currently a stack trace looks like: [{Mod1,Function1,Arity1}, . . . {ModN,FunctionN,ArityN}] Add a forth element to each tuple that can be used indication the filename and line number of the source file: [{Mod1,Function1,Arity1,Location1}, . . . {ModN,FunctionN,ArityN,LocationN}] In this commit, the fourth element will just be an empty list, and we will change all code that look at or manipulate stacktraces. --- lib/stdlib/src/c.erl | 2 +- lib/stdlib/src/escript.erl | 2 +- lib/stdlib/src/gen_event.erl | 8 ++++---- lib/stdlib/src/gen_fsm.erl | 6 +++--- lib/stdlib/src/gen_server.erl | 6 +++--- lib/stdlib/src/lib.erl | 46 ++++++++++++++++++++++++++++--------------- lib/stdlib/src/qlc.erl | 7 ++++--- lib/stdlib/src/re.erl | 16 +++++++-------- lib/stdlib/src/shell.erl | 2 +- lib/stdlib/src/unicode.erl | 12 +++++------ 10 files changed, 61 insertions(+), 46 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index febfdd6285..a920921a5e 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -797,7 +797,7 @@ appcall(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args}|_] -> + [{M,F,Args,_}|_] -> Arity = length(Args), io:format("Call to ~w:~w/~w in application ~w failed.\n", [M,F,Arity,App]); diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index d67617260e..2325bb63e5 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -866,7 +866,7 @@ hidden_apply(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args} | _] -> + [{M,F,Args,_} | _] -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1c4a73680b..d1dd074fba 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -667,16 +667,16 @@ report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> Reason1 = case Reason of - {'EXIT',{undef,[{M,F,A}|MFAs]}} -> + {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> - {undef,[{M,F,A}|MFAs]}; + {undef,[{M,F,A,L}|MFAs]}; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; {'EXIT',Why} -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index f2f1365d3d..ea21136bdb 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -561,16 +561,16 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> error_info(Reason, Name, Msg, StateName, StateData, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 09d94a9c40..b8ea3a4de2 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -729,16 +729,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index c303ae60b5..314fd60903 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -173,12 +173,12 @@ format_fun(Fun) when is_function(Fun) -> analyze_exception(error, Term, Stack) -> case {is_stacktrace(Stack), Stack, Term} of - {true, [{_M,_F,As}=MFA|MFAs], function_clause} when is_list(As) -> - {Term,[MFA],MFAs}; - {true, [{shell,F,A}], function_clause} when is_integer(A) -> + {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) -> + {Term,[MFAL],MFAs}; + {true, [{shell,F,A,_}], function_clause} when is_integer(A) -> {Term, [{F,A}], []}; - {true, [{_M,_F,_AorAs}=MFA|MFAs], undef} -> - {Term,[MFA],MFAs}; + {true, [{_,_,_,_}=MFAL|MFAs], undef} -> + {Term,[MFAL],MFAs}; {true, _, _} -> {Term,[],Stack}; {false, _, _} -> @@ -194,9 +194,11 @@ analyze_exception(_Class, Term, Stack) -> is_stacktrace([]) -> true; -is_stacktrace([{M,F,A}|Fs]) when is_atom(M), is_atom(F), is_integer(A) -> +is_stacktrace([{M,F,A,I}|Fs]) + when is_atom(M), is_atom(F), is_integer(A), is_list(I) -> is_stacktrace(Fs); -is_stacktrace([{M,F,As}|Fs]) when is_atom(M), is_atom(F), length(As) >= 0 -> +is_stacktrace([{M,F,As,I}|Fs]) + when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) -> is_stacktrace(Fs); is_stacktrace(_) -> false. @@ -225,9 +227,9 @@ explain_reason(function_clause, error, [{F,A}], _PF, _S) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As}], PF, S) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S) -> Str = <<"no function clause matching ">>, - format_errstr_call(Str, Cl, {M,F}, As, PF, S); + [format_errstr_call(Str, Cl, {M,F}, As, PF, S),$\s|location(Loc)]; explain_reason(if_clause, error, [], _PF, _S) -> <<"no true branch found when evaluating an if expression">>; explain_reason(noproc, error, [], _PF, _S) -> @@ -242,11 +244,11 @@ explain_reason({try_clause,V}, error=Cl, [], PF, S) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A}], _PF, _S) -> +explain_reason(undef, error, [{M,F,A,_}], _PF, _S) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~s">>, [mfa_to_string(M, F, n_args(A))]); -explain_reason({shell_undef,F,A}, error, [], _PF, _S) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]); @@ -292,17 +294,19 @@ argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). format_stacktrace1(S0, Stack0, PF, SF) -> - Stack1 = lists:dropwhile(fun({M,F,A}) -> SF(M, F, A) + Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), format_stacktrace2(S, Stack, 1, PF). -format_stacktrace2(S, [{M,F,A}|Fs], N, PF) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~s">>, - [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A)]) +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF) when is_integer(A) -> + [io_lib:fwrite(<<"~s~s ~s ~s">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A), + location(L)]) | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], C = format_call("", CalledAs, {M,F}, As, PF), @@ -313,6 +317,16 @@ format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> format_stacktrace2(_S, [], _N, _PF) -> "". +location(L) -> + File = proplists:get_value(file, L), + Line = proplists:get_value(line, L), + if + File =/= undefined, Line =/= undefined -> + io_lib:format("(~s, line ~w)", [File, Line]); + true -> + "" + end. + sep(1, S) -> S; sep(_, S) -> [$\n | S]. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 5ca04ff023..f5e180b4bd 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -123,7 +123,7 @@ -record(setup, {parent}). --define(THROWN_ERROR, {?MODULE, throw_error, _}). +-define(THROWN_ERROR, {?MODULE, throw_error, _, _}). -export_type([query_handle/0]). @@ -3701,7 +3701,8 @@ lookup_join(F1, C1, LuF, C2, Rev) -> maybe_error_logger(allowed, _) -> ok; maybe_error_logger(Name, Why) -> - [_, _, {?MODULE,maybe_error_logger,_} | Stacktrace] = expand_stacktrace(), + [_, _, {?MODULE,maybe_error_logger,_,_} | Stacktrace] = + expand_stacktrace(), Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), @@ -3720,7 +3721,7 @@ expand_stacktrace() -> expand_stacktrace(D) -> _ = erlang:system_flag(backtrace_depth, D), {'EXIT', {foo, Stacktrace}} = (catch erlang:error(foo)), - L = lists:takewhile(fun({M,_,_}) -> M =/= ?MODULE + L = lists:takewhile(fun({M,_,_,_}) -> M =/= ?MODULE end, lists:reverse(Stacktrace)), if length(L) < 3 andalso length(Stacktrace) =:= D -> diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index e08258a535..99bcbd722e 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -573,10 +573,10 @@ ucompile(RE,Options) -> re:compile(unicode:characters_to_binary(RE,unicode),Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [RE,Options])), - erlang:raise(error,AnyError,[{Mod,compile,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,compile,L,Loc}|Rest]) end. @@ -585,10 +585,10 @@ urun(Subject,RE,Options) -> urun2(Subject,RE,Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. urun2(Subject0,RE0,Options0) -> @@ -625,20 +625,20 @@ grun(Subject,RE,{Options,NeedClean}) -> grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end; grun(Subject,RE,{Options,NeedClean,OrigRE}) -> try grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,OrigRE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. grun2(Subject,RE,{Options,NeedClean}) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index e3e23e09bc..964697cae6 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1088,7 +1088,7 @@ shell_default(F,As,Bs) -> end. shell_undef(F,A) -> - erlang:error({shell_undef,F,A}). + erlang:error({shell_undef,F,A,[]}). local_func_handler(Shell, RT, Ef) -> H = fun(Lf) -> diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index a5d9965ca2..e9b90befe6 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -73,7 +73,7 @@ characters_to_list_int(ML, Encoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Encoding])), erlang:raise(error,TheError,[{Mod,characters_to_list,L}|Rest]) @@ -109,7 +109,7 @@ characters_to_binary(ML) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -127,7 +127,7 @@ characters_to_binary_int(ML,InEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -159,7 +159,7 @@ characters_to_binary(ML, latin1, Uni) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,latin1,Uni])), erlang:raise(error,TheError, @@ -181,7 +181,7 @@ characters_to_binary(ML,Uni,latin1) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Uni,latin1])), erlang:raise(error,TheError, @@ -200,7 +200,7 @@ characters_to_binary(ML, InEncoding, OutEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding,OutEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) -- cgit v1.2.3 From 053fb064496043207cfa807c900077f9bbc4c7d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 21 Feb 2011 16:53:34 +0100 Subject: compiler: Don't create filenames starting with "./" In the location information tables in the run-time system, source filenames that are the same as the module name plus ".erl" extension are not stored explicitly, thus saving memory. To take advantage of that optimization, avoid complicating the names of files in the current working directory; specifically, make sure that "./" is not prepended to the name. --- lib/stdlib/src/epp.erl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d804c1dee5..230a4a0612 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -684,7 +684,7 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {error,_E1} -> case catch find_lib_dir(NewName) of {LibDir, Rest} when is_list(LibDir) -> - LibName = filename:join([LibDir | Rest]), + LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> ExtraPath = [filename:dirname(LibName)], @@ -1154,7 +1154,12 @@ expand_var1(NewName) -> [[$$ | Var] | Rest] = filename:split(NewName), Value = os:getenv(Var), true = Value =/= false, - {ok, filename:join([Value | Rest])}. + {ok, fname_join([Value | Rest])}. + +fname_join(["." | [_|_]=Rest]) -> + fname_join(Rest); +fname_join(Components) -> + filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) loc_attr(Line) when is_integer(Line) -> -- cgit v1.2.3 From 66144dba0c398c4fd2e21581b7264e861e872701 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 8 Mar 2011 07:19:47 +0100 Subject: beam_lib: Retain the "Line" chunk when stripping BEAM files --- lib/stdlib/src/beam_lib.erl | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index d9c645d787..9077e59fdc 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -224,7 +224,7 @@ version(File) -> MD5 :: binary(). md5(File) -> - case catch read_significant_chunks(File) of + case catch read_significant_chunks(File, md5_chunks()) of {ok, {Module, Chunks0}} -> Chunks = filter_funtab(Chunks0), {ok, {Module, erlang:md5([C || {_Id, C} <- Chunks])}}; @@ -395,7 +395,7 @@ strip_fils(Files) -> %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File), + {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of @@ -453,8 +453,8 @@ is_useless_chunk("CInf") -> true; is_useless_chunk(_) -> false. %% -> {ok, {Module, Chunks}} | throw(Error) -read_significant_chunks(File) -> - case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of +read_significant_chunks(File, ChunkList) -> + case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> Mandatory = mandatory_chunks(), Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module), @@ -835,12 +835,15 @@ file_error(FileName, {error, Reason}) -> error(Reason) -> throw({error, ?MODULE, Reason}). - -%% The following chunks are significant when calculating the MD5 for a module, -%% and also the modules that must be retained when stripping a file. -%% They are listed in the order that they should be MD5:ed. +%% The following chunks must be kept when stripping a BEAM file. significant_chunks() -> + ["Line" | md5_chunks()]. + +%% The following chunks are significant when calculating the MD5 +%% for a module. They are listed in the order that they should be MD5:ed. + +md5_chunks() -> ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. %% The following chunks are mandatory in every Beam file. -- cgit v1.2.3