diff options
Diffstat (limited to 'lib')
33 files changed, 1116 insertions, 484 deletions
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 7b4cd814a2..bb93110176 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -281,12 +281,12 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); -forward([{test,is_eq_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) -> +forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) -> case Is of [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) end; -forward([{test,is_ne_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) -> +forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) -> case Is of [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) @@ -371,10 +371,10 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> To = shortcut_bs_start_match(To0, Src, D), I = {test,bs_start_match2,{f,To},Live,Info,Dst}, backward(Is, D, [I|Acc]); -backward([{test,is_eq_exact=Op,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) -> +backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To = shortcut_fail_label(To1, Reg, Val, D), - I = {test,Op,{f,To},Ops}, + I = combine_eqs(To, Ops, D, Acc), backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), @@ -394,7 +394,10 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> _Code -> To2 end, - I = {test,Op,{f,To},Ops0}, + I = case Op of + is_eq_exact -> combine_eqs(To, Ops0, D, Acc); + _ -> {test,Op,{f,To},Ops0} + end, backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), @@ -519,6 +522,41 @@ bif_to_test(Name, Args, Fail) -> not_possible() -> throw(not_possible). +%% combine_eqs(To, Operands, Acc) -> Instruction. +%% Combine two is_eq_exact instructions or (an is_eq_exact +%% instruction and a select_val instruction) to a select_val +%% instruction if possible. +%% +%% Example: +%% +%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1 +%% L1: . Lit2 L2 ] +%% . +%% . ==> +%% . +%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2 +%% L2: .... L2: +%% +combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_]) + when Type =:= atom; Type =:= integer -> + case beam_utils:code_at(To, D) of + [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]}, + {label,L2}|_] when Lit1 =/= Lit2 -> + {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}}; + [{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] -> + List = remove_from_list(Lit1, List0), + {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}}; + _Is -> + {test,is_eq_exact,{f,To},Ops} + end; +combine_eqs(To, Ops, _D, _Acc) -> + {test,is_eq_exact,{f,To},Ops}. + +remove_from_list(Lit, [Lit,{f,_}|T]) -> + T; +remove_from_list(Lit, [Val,{f,_}=Fail|T]) -> + [Val,Fail|remove_from_list(Lit, T)]; +remove_from_list(_, []) -> []. %% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel' %% Try to shortcut the failure label for a bit syntax matching. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index d03ac4b1f4..f39fc50b95 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -64,22 +64,7 @@ function({function,Name,Arity,CLabel,Is0}) -> %% InEncoding =:= latin1, OutEncoding =:= unicode; %% InEncoding =:= latin1, OutEncoding =:= utf8 -> %% -%% (2) Code like -%% -%% is_ne_exact Fail Reg Literal1 -%% is_ne_exact Fail Reg Literal2 -%% is_ne_exact Fail Reg Literal3 -%% is_eq_exact UltimateFail Reg Literal4 -%% Fail: .... -%% -%% can be rewritten to -%% -%% select_val Reg UltimateFail [ Literal1 Fail -%% Literal2 Fail -%% Literal3 Fail -%% Literal4 Fail ] -%% -%% (3) A select_val/4 instruction that only verifies that +%% (2) A select_val/4 instruction that only verifies that %% its argument is either 'true' or 'false' can be %% be replaced with an is_boolean/2 instruction. That is: %% @@ -132,7 +117,7 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> false -> %% Remember that we have seen this test. SeenTests = gb_sets:insert(Test, SeenTests0), - make_select_val(I, Is, SeenTests, Acc) + peep(Is, SeenTests, [I|Acc]) end end; peep([{select_val,Src,Fail, @@ -151,33 +136,6 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). -make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0, - Is0, SeenTests, Acc) -> - try - Type = case Lit of - {atom,_} -> atom; - {integer,_} -> integer; - _ -> throw(impossible) - end, - {I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]), - peep([I|Is], SeenTests, Acc) - catch - impossible -> - peep(Is0, SeenTests, [I0|Acc]) - end; -make_select_val(I, Is, SeenTests, Acc) -> - peep(Is, SeenTests, [I|Acc]). - -make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is], - Fail, Val, Type, Acc) -> - make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]); -make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} | - [{label,Fail}|_]=Is], Fail, Val, Type, Acc) -> - Choices = [Lit,{f,Fail}|Acc], - I = {select_val,Val,{f,UltimateFail},{list,Choices}}, - {I,Is}; -make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible). - kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). @@ -187,5 +145,3 @@ kill_seen_1([{_,Ops}=Test|T], Dst) -> false -> [Test|kill_seen_1(T, Dst)] end; kill_seen_1([], _) -> []. - - diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 6202f07479..96015fbe58 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1038,6 +1038,8 @@ fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> eval_setelement(Call, Arg1, Arg2, Arg3); +fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> + eval_is_record(Call, Arg1, Arg2, Arg3, Sub); fold_non_lit_args(Call, erlang, N, Args, Sub) -> NumArgs = length(Args), case erl_internal:comp_op(N, NumArgs) of @@ -1194,19 +1196,22 @@ eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer true -> eval_failure(Call, badarg) end; -%% eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) -%% when is_integer(Pos) -> -%% case orddict:find(V, Types#sub.t) of -%% {ok,#c_tuple{es=Elements}} -> -%% if -%% 1 =< Pos, Pos =< length(Elements) -> -%% lists:nth(Pos, Elements); -%% true -> -%% eval_failure(Call, badarg) -%% end; -%% error -> -%% Call -%% end; +eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) + when is_integer(Pos) -> + case orddict:find(V, Types#sub.t) of + {ok,#c_tuple{es=Elements}} -> + if + 1 =< Pos, Pos =< length(Elements) -> + case lists:nth(Pos, Elements) of + #c_alias{var=Alias} -> Alias; + Res -> Res + end; + true -> + eval_failure(Call, badarg) + end; + error -> + Call + end; eval_element(Call, Pos, Tuple, _Types) -> case is_not_integer(Pos) orelse is_not_tuple(Tuple) of true -> @@ -1215,6 +1220,20 @@ eval_element(Call, Pos, Tuple, _Types) -> Call end. +%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. +%% Evaluates is_record/3 using type information. +%% +eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit, + #c_literal{val=Size}, Types) -> + case orddict:find(V, Types#sub.t) of + {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} -> + Lit#c_literal{val=Tag =:= NeededTag andalso + length(Es) =:= Size}; + _ -> + Call + end; +eval_is_record(Call, _, _, _, _) -> Call. + %% is_not_integer(Core) -> true | false. %% Returns true if Core is definitely not an integer. diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index a2937d60b8..f0d54a2f3e 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%%---------------------------------------------------------------------- @@ -564,7 +564,7 @@ recv_challenge(#hs_data{socket=Socket,other_node=Node, case Recv(Socket, 0, infinity) of {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> Flags = ?u32(Fl1,Fl2,Fl3,Fl4), - case {list_to_existing_atom(Ns),?u16(V1,V0)} of + try {list_to_existing_atom(Ns),?u16(V1,V0)} of {Node,Version} -> Challenge = ?u32(CA3,CA2,CA1,CA0), ?trace("recv: node=~w, challenge=~w version=~w\n", @@ -572,6 +572,9 @@ recv_challenge(#hs_data{socket=Socket,other_node=Node, {Flags,Challenge}; _ -> ?shutdown(no_node) + catch + error:badarg -> + ?shutdown(no_node) end; _ -> ?shutdown(no_node) diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index 669a361c9d..1289e176c7 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(inet_dns). @@ -129,27 +129,33 @@ do_decode(<<Id:16, RA:1,PR:1,_:2,Rcode:4, QdCount:16,AnCount:16,NsCount:16,ArCount:16, QdBuf/binary>>=Buffer) -> - {AnBuf,QdList} = decode_query_section(QdBuf,QdCount,Buffer), - {NsBuf,AnList} = decode_rr_section(AnBuf,AnCount,Buffer), - {ArBuf,NsList} = decode_rr_section(NsBuf,NsCount,Buffer), - {Rest,ArList} = decode_rr_section(ArBuf,ArCount,Buffer), + {AnBuf,QdList,QdTC} = decode_query_section(QdBuf,QdCount,Buffer), + {NsBuf,AnList,AnTC} = decode_rr_section(AnBuf,AnCount,Buffer), + {ArBuf,NsList,NsTC} = decode_rr_section(NsBuf,NsCount,Buffer), + {Rest,ArList,ArTC} = decode_rr_section(ArBuf,ArCount,Buffer), case Rest of <<>> -> + HdrTC = decode_boolean(TC), DnsHdr = #dns_header{id=Id, qr=decode_boolean(QR), opcode=decode_opcode(Opcode), aa=decode_boolean(AA), - tc=decode_boolean(TC), + tc=HdrTC, rd=decode_boolean(RD), ra=decode_boolean(RA), pr=decode_boolean(PR), rcode=Rcode}, - #dns_rec{header=DnsHdr, - qdlist=QdList, - anlist=AnList, - nslist=NsList, - arlist=ArList}; + case QdTC or AnTC or NsTC or ArTC of + true when not HdrTC -> + throw(?DECODE_ERROR); + _ -> + #dns_rec{header=DnsHdr, + qdlist=QdList, + anlist=AnList, + nslist=NsList, + arlist=ArList} + end; _ -> %% Garbage data after DNS message throw(?DECODE_ERROR) @@ -161,8 +167,10 @@ do_decode(_) -> decode_query_section(Bin, N, Buffer) -> decode_query_section(Bin, N, Buffer, []). +decode_query_section(<<>>=Rest, N, _Buffer, Qs) -> + {Rest,reverse(Qs),N =/= 0}; decode_query_section(Rest, 0, _Buffer, Qs) -> - {Rest,reverse(Qs)}; + {Rest,reverse(Qs),false}; decode_query_section(Bin, N, Buffer, Qs) -> case decode_name(Bin, Buffer) of {<<Type:16,Class:16,Rest/binary>>,Name} -> @@ -179,8 +187,10 @@ decode_query_section(Bin, N, Buffer, Qs) -> decode_rr_section(Bin, N, Buffer) -> decode_rr_section(Bin, N, Buffer, []). +decode_rr_section(<<>>=Rest, N, _Buffer, RRs) -> + {Rest,reverse(RRs),N =/= 0}; decode_rr_section(Rest, 0, _Buffer, RRs) -> - {Rest,reverse(RRs)}; + {Rest,reverse(RRs),false}; decode_rr_section(Bin, N, Buffer, RRs) -> case decode_name(Bin, Buffer) of {<<T:16/unsigned,C:16/unsigned,TTL:4/binary, diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 9b9e078898..de0f23bf24 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% RFC 1035, 2671, 2782, 2915. @@ -592,6 +592,7 @@ query_retries(_Q, _NSs, _Timer, Retry, Retry, S) -> query_retries(Q, NSs, Timer, Retry, I, S0) -> Num = length(NSs), if Num =:= 0 -> + udp_close(S0), {error,timeout}; true -> case query_nss(Q, NSs, Timer, Retry, I, S0, []) of diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 3afaedf274..0e17c059e5 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(net_kernel). @@ -72,7 +72,7 @@ -export([publish_on_node/1, update_publish_nodes/1]). -%% Internal Exports +%% Internal Exports -export([do_spawn/3, spawn_func/6, ticker/2, @@ -94,7 +94,7 @@ connecttime, %% the connection setuptime. connections, %% table of connections conn_owners = [], %% List of connection owner pids, - pend_owners = [], %% List of potential owners + pend_owners = [], %% List of potential owners listen, %% list of #listen allowed, %% list of allowed nodes in a restricted system verbose = 0, %% level of verboseness @@ -232,7 +232,7 @@ do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden %% "connected from other end.~n",[Node]), true; {Pid, false} -> - ?connect_failure(Node,{barred_connection, + ?connect_failure(Node,{barred_connection, ets:lookup(sys_dist, Node)}), %%io:format("Net Kernel: barred connection (~p) " %% "- failure.~n",[Node]), @@ -244,12 +244,12 @@ do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden {ok, never} -> ?connect_failure(Node,{dist_auto_connect,never}), false; - % This might happen due to connection close + % This might happen due to connection close % not beeing propagated to user space yet. - % Save the day by just not connecting... + % Save the day by just not connecting... {ok, once} when Else =/= [], (hd(Else))#connection.state =:= up -> - ?connect_failure(Node,{barred_connection, + ?connect_failure(Node,{barred_connection, ets:lookup(sys_dist, Node)}), false; _ -> @@ -276,8 +276,8 @@ passive_connect_monitor(Parent, Node) -> Parent ! {self(),true} end end. - -%% If the net_kernel isn't running we ignore all requests to the + +%% If the net_kernel isn't running we ignore all requests to the %% kernel, thus basically accepting them :-) request(Req) -> case whereis(net_kernel) of @@ -302,7 +302,7 @@ start_link([Name, LongOrShortNames]) -> start_link([Name, LongOrShortNames, 15000]); start_link([Name, LongOrShortNames, Ticktime]) -> - case gen_server:start_link({local, net_kernel}, net_kernel, + case gen_server:start_link({local, net_kernel}, net_kernel, {Name, LongOrShortNames, Ticktime}, []) of {ok, Pid} -> {ok, Pid}; @@ -313,7 +313,7 @@ start_link([Name, LongOrShortNames, Ticktime]) -> end. %% auth:get_cookie should only be able to return an atom -%% tuple cookies are unknowns +%% tuple cookies are unknowns init({Name, LongOrShortNames, TickT}) -> process_flag(trap_exit,true), @@ -354,13 +354,13 @@ init({Name, LongOrShortNames, TickT}) -> %% The response is delayed until the connection is up and %% running. %% -handle_call({connect, _, Node}, _From, State) when Node =:= node() -> - {reply, true, State}; +handle_call({connect, _, Node}, From, State) when Node =:= node() -> + async_reply({reply, true, State}, From); handle_call({connect, Type, Node}, From, State) -> verbose({connect, Type, Node}, 1, State), case ets:lookup(sys_dist, Node) of [Conn] when Conn#connection.state =:= up -> - {reply, true, State}; + async_reply({reply, true, State}, From); [Conn] when Conn#connection.state =:= pending -> Waiting = Conn#connection.waiting, ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}), @@ -376,74 +376,75 @@ handle_call({connect, Type, Node}, From, State) -> {noreply,State#state{conn_owners=Owners}}; _ -> ?connect_failure(Node, {setup_call, failed}), - {reply, false, State} + async_reply({reply, false, State}, From) end end; %% %% Close the connection to Node. %% -handle_call({disconnect, Node}, _From, State) when Node =:= node() -> - {reply, false, State}; -handle_call({disconnect, Node}, _From, State) -> +handle_call({disconnect, Node}, From, State) when Node =:= node() -> + async_reply({reply, false, State}, From); +handle_call({disconnect, Node}, From, State) -> verbose({disconnect, Node}, 1, State), {Reply, State1} = do_disconnect(Node, State), - {reply, Reply, State1}; + async_reply({reply, Reply, State1}, From); -%% +%% %% The spawn/4 BIF ends up here. -%% +%% handle_call({spawn,M,F,A,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([no_link,{From,Tag},M,F,A,Gleader],[],State); -%% +%% %% The spawn_link/4 BIF ends up here. -%% +%% handle_call({spawn_link,M,F,A,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([link,{From,Tag},M,F,A,Gleader],[],State); -%% +%% %% The spawn_opt/5 BIF ends up here. -%% +%% handle_call({spawn_opt,M,F,A,O,L,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([L,{From,Tag},M,F,A,Gleader],O,State); -%% +%% %% Only allow certain nodes. -%% -handle_call({allow, Nodes}, _From, State) -> +%% +handle_call({allow, Nodes}, From, State) -> case all_atoms(Nodes) of true -> Allowed = State#state.allowed, - {reply,ok,State#state{allowed = Allowed ++ Nodes}}; + async_reply({reply,ok,State#state{allowed = Allowed ++ Nodes}}, + From); false -> - {reply,error,State} + async_reply({reply,error,State}, From) end; -%% +%% %% authentication, used by auth. Simply works as this: %% if the message comes through, the other node IS authorized. -%% -handle_call({is_auth, _Node}, _From, State) -> - {reply,yes,State}; +%% +handle_call({is_auth, _Node}, From, State) -> + async_reply({reply,yes,State}, From); -%% +%% %% Not applicable any longer !? -%% -handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State) +%% +handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State) when is_pid(From), node(From) =:= node() -> - gen_server:reply({From,Tag}, not_implemented), + async_gen_server_reply({From,Tag}, not_implemented), % Port = State#state.port, % catch apply(Mod,Fun,[Port|Args]), {noreply,State}; -handle_call(longnames, _From, State) -> - {reply, get(longnames), State}; +handle_call(longnames, From, State) -> + async_reply({reply, get(longnames), State}, From); -handle_call({update_publish_nodes, Ns}, _From, State) -> - {reply, ok, State#state{publish_on_nodes = Ns}}; +handle_call({update_publish_nodes, Ns}, From, State) -> + async_reply({reply, ok, State#state{publish_on_nodes = Ns}}, From); -handle_call({publish_on_node, Node}, _From, State) -> +handle_call({publish_on_node, Node}, From, State) -> NewState = case State#state.publish_on_nodes of undefined -> State#state{publish_on_nodes = @@ -457,11 +458,12 @@ handle_call({publish_on_node, Node}, _From, State) -> Nodes -> lists:member(Node, Nodes) end, - {reply, Publish, NewState}; + async_reply({reply, Publish, NewState}, From); -handle_call({verbose, Level}, _From, State) -> - {reply, State#state.verbose, State#state{verbose = Level}}; +handle_call({verbose, Level}, From, State) -> + async_reply({reply, State#state.verbose, State#state{verbose = Level}}, + From); %% %% Set new ticktime @@ -471,16 +473,16 @@ handle_call({verbose, Level}, _From, State) -> %% #tick_change{} record if the ticker process has been upgraded; %% otherwise, an integer or an atom. -handle_call(ticktime, _, #state{tick = #tick{time = T}} = State) -> - {reply, T, State}; -handle_call(ticktime, _, #state{tick = #tick_change{time = T}} = State) -> - {reply, {ongoing_change_to, T}, State}; +handle_call(ticktime, From, #state{tick = #tick{time = T}} = State) -> + async_reply({reply, T, State}, From); +handle_call(ticktime, From, #state{tick = #tick_change{time = T}} = State) -> + async_reply({reply, {ongoing_change_to, T}, State}, From); -handle_call({new_ticktime,T,_TP}, _, #state{tick = #tick{time = T}} = State) -> +handle_call({new_ticktime,T,_TP}, From, #state{tick = #tick{time = T}} = State) -> ?tckr_dbg(no_tick_change), - {reply, unchanged, State}; + async_reply({reply, unchanged, State}, From); -handle_call({new_ticktime,T,TP}, _, #state{tick = #tick{ticker = Tckr, +handle_call({new_ticktime,T,TP}, From, #state{tick = #tick{ticker = Tckr, time = OT}} = State) -> ?tckr_dbg(initiating_tick_change), start_aux_ticker(T, OT, TP), @@ -493,14 +495,18 @@ handle_call({new_ticktime,T,TP}, _, #state{tick = #tick{ticker = Tckr, ?tckr_dbg(shorter_ticktime), shorter end, - {reply, change_initiated, State#state{tick = #tick_change{ticker = Tckr, - time = T, - how = How}}}; + async_reply({reply, change_initiated, + State#state{tick = #tick_change{ticker = Tckr, + time = T, + how = How}}}, From); -handle_call({new_ticktime,_,_}, +handle_call({new_ticktime,From,_}, _, #state{tick = #tick_change{time = T}} = State) -> - {reply, {ongoing_change_to, T}, State}. + async_reply({reply, {ongoing_change_to, T}, State}, From); + +handle_call(_Msg, _From, State) -> + {noreply, State}. %% ------------------------------------------------------------ %% handle_cast. @@ -568,7 +574,7 @@ handle_info({accept,AcceptPid,Socket,Family,Proto}, State) -> %% %% A node has successfully been connected. %% -handle_info({SetupPid, {nodeup,Node,Address,Type,Immediate}}, +handle_info({SetupPid, {nodeup,Node,Address,Type,Immediate}}, State) -> case {Immediate, ets:lookup(sys_dist, Node)} of {true, [Conn]} when Conn#connection.state =:= pending, @@ -656,7 +662,7 @@ handle_info({From,registered_send,To,Mess},State) -> send(From,To,Mess), {noreply,State}; -%% badcookies SHOULD not be sent +%% badcookies SHOULD not be sent %% (if someone does erlang:set_cookie(node(),foo) this may be) handle_info({From,badcookie,_To,_Mess}, State) -> error_logger:error_msg("~n** Got OLD cookie from ~w~n", @@ -704,7 +710,7 @@ handle_info(X, State) -> %% 4. The ticker process. %% (5. Garbage pid.) %% -%% The process type function that handled the process throws +%% The process type function that handled the process throws %% the handle_info return value ! %% ----------------------------------------------------------- @@ -994,9 +1000,9 @@ ticker(Kernel, Tick) when is_integer(Tick) -> ticker_loop(Kernel, Tick). to_integer(T) when is_integer(T) -> T; -to_integer(T) when is_atom(T) -> +to_integer(T) when is_atom(T) -> list_to_integer(atom_to_list(T)); -to_integer(T) when is_list(T) -> +to_integer(T) when is_list(T) -> list_to_integer(T). ticker_loop(Kernel, Tick) -> @@ -1004,7 +1010,7 @@ ticker_loop(Kernel, Tick) -> {new_ticktime, NewTick} -> ?tckr_dbg({ticker_changed_time, Tick, NewTick}), ?MODULE:ticker_loop(Kernel, NewTick) - after Tick -> + after Tick -> Kernel ! tick, ?MODULE:ticker_loop(Kernel, Tick) end. @@ -1052,7 +1058,7 @@ send(_From,To,Mess) -> -ifdef(UNUSED). safesend(Name,Mess) when is_atom(Name) -> - case whereis(Name) of + case whereis(Name) of undefined -> Mess; P when is_pid(P) -> @@ -1063,11 +1069,12 @@ safesend(Pid, Mess) -> Pid ! Mess. -endif. do_spawn(SpawnFuncArgs, SpawnOpts, State) -> + [_,From|_] = SpawnFuncArgs, case catch spawn_opt(?MODULE, spawn_func, SpawnFuncArgs, SpawnOpts) of - {'EXIT', {Reason,_}} -> - {reply, {'EXIT', {Reason,[]}}, State}; - {'EXIT', Reason} -> - {reply, {'EXIT', {Reason,[]}}, State}; + {'EXIT', {Reason,_}} -> + async_reply({reply, {'EXIT', {Reason,[]}}, State}, From); + {'EXIT', Reason} -> + async_reply({reply, {'EXIT', {Reason,[]}}, State}, From); _ -> {noreply,State} end. @@ -1079,11 +1086,11 @@ do_spawn(SpawnFuncArgs, SpawnOpts, State) -> spawn_func(link,{From,Tag},M,F,A,Gleader) -> link(From), - gen_server:reply({From,Tag},self()), %% ahhh + async_gen_server_reply({From,Tag},self()), %% ahhh group_leader(Gleader,self()), apply(M,F,A); spawn_func(_,{From,Tag},M,F,A,Gleader) -> - gen_server:reply({From,Tag},self()), %% ahhh + async_gen_server_reply({From,Tag},self()), %% ahhh group_leader(Gleader,self()), apply(M,F,A). @@ -1145,7 +1152,7 @@ get_proto_mod(Family,Protocol,[L|Ls]) -> true -> get_proto_mod(Family,Protocol,Ls) end; -get_proto_mod(_Family, _Protocol, []) -> +get_proto_mod(_Family, _Protocol, []) -> error. %% -------- Initialisation functions ------------------------ @@ -1156,9 +1163,9 @@ init_node(Name, LongOrShortNames) -> case create_name(Name, LongOrShortNames, 1) of {ok,Node} -> case start_protos(list_to_atom(NameWithoutHost),Node) of - {ok, Ls} -> + {ok, Ls} -> {ok, Node, Ls}; - Error -> + Error -> Error end; Error -> @@ -1167,9 +1174,9 @@ init_node(Name, LongOrShortNames) -> %% Create the node name create_name(Name, LongOrShortNames, Try) -> - put(longnames, case LongOrShortNames of - shortnames -> false; - longnames -> true + put(longnames, case LongOrShortNames of + shortnames -> false; + longnames -> true end), {Head,Host1} = create_hostpart(Name, LongOrShortNames), case Host1 of @@ -1218,7 +1225,7 @@ create_hostpart(Name, LongOrShortNames) -> {Head,Host1}. %% -%% +%% %% protocol_childspecs() -> case init:get_argument(proto_dist) of @@ -1228,7 +1235,7 @@ protocol_childspecs() -> protocol_childspecs(["inet_tcp"]) end. -protocol_childspecs([]) -> +protocol_childspecs([]) -> []; protocol_childspecs([H|T]) -> Mod = list_to_atom(H ++ "_dist"), @@ -1238,15 +1245,15 @@ protocol_childspecs([H|T]) -> _ -> protocol_childspecs(T) end. - - + + %% %% epmd_module() -> module_name of erl_epmd or similar gen_server_module. %% epmd_module() -> case init:get_argument(epmd_module) of - {ok,[[Module]]} -> + {ok,[[Module]]} -> Module; _ -> erl_epmd @@ -1293,7 +1300,7 @@ start_protos(Name, [Proto | Ps], Node, Ls) -> error_logger:info_msg("Protocol: ~p: not supported~n", [Proto]), start_protos(Name,Ps, Node, Ls); {'EXIT', Reason} -> - error_logger:info_msg("Protocol: ~p: register error: ~p~n", + error_logger:info_msg("Protocol: ~p: register error: ~p~n", [Proto, Reason]), start_protos(Name,Ps, Node, Ls); {error, duplicate_name} -> @@ -1303,7 +1310,7 @@ start_protos(Name, [Proto | Ps], Node, Ls) -> [Proto]), start_protos(Name,Ps, Node, Ls); {error, Reason} -> - error_logger:info_msg("Protocol: ~p: register/listen error: ~p~n", + error_logger:info_msg("Protocol: ~p: register/listen error: ~p~n", [Proto, Reason]), start_protos(Name,Ps, Node, Ls) end; @@ -1409,7 +1416,7 @@ reply_waiting(_Node, Waiting, Rep) -> reply_waiting1(lists:reverse(Waiting), Rep). reply_waiting1([From|W], Rep) -> - gen_server:reply(From, Rep), + async_gen_server_reply(From, Rep), reply_waiting1(W, Rep); reply_waiting1([], _) -> ok. @@ -1455,7 +1462,7 @@ display_info({Node, Info}, {I,O}) -> integer_to_list(In), integer_to_list(Out), Address), {I+In,O+Out}. -fmt_address(undefined) -> +fmt_address(undefined) -> "-"; fmt_address(A) -> case A#net_address.family of @@ -1511,3 +1518,19 @@ verbose(_, _, _) -> getnode(P) when is_pid(P) -> node(P); getnode(P) -> P. + +async_reply({reply, Msg, State}, From) -> + async_gen_server_reply(From, Msg), + {noreply, State}. + +async_gen_server_reply(From, Msg) -> + {Pid, Tag} = From, + M = {Tag, Msg}, + case catch erlang:send(Pid, M, [nosuspend, noconnect]) of + true -> + M; + false -> + spawn(fun() -> gen_server:reply(From, Msg) end); + EXIT -> + EXIT + end. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index d0b498edc9..75a11a8afd 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -50,7 +50,7 @@ find_executable(Name, Path) -> relative -> find_executable1(Name, split_path(Path), Extensions); _ -> - case verify_executable(Name, Extensions) of + case verify_executable(Name, Extensions, Extensions) of {ok, Complete} -> Complete; error -> @@ -60,7 +60,7 @@ find_executable(Name, Path) -> find_executable1(Name, [Base|Rest], Extensions) -> Complete0 = filename:join(Base, Name), - case verify_executable(Complete0, Extensions) of + case verify_executable(Complete0, Extensions, Extensions) of {ok, Complete} -> Complete; error -> @@ -69,7 +69,7 @@ find_executable1(Name, [Base|Rest], Extensions) -> find_executable1(_Name, [], _Extensions) -> false. -verify_executable(Name0, [Ext|Rest]) -> +verify_executable(Name0, [Ext|Rest], OrigExtensions) -> Name1 = Name0 ++ Ext, case os:type() of vxworks -> @@ -78,7 +78,7 @@ verify_executable(Name0, [Ext|Rest]) -> {ok, _} -> {ok, Name1}; _ -> - verify_executable(Name0, Rest) + verify_executable(Name0, Rest, OrigExtensions) end; _ -> case file:read_file_info(Name1) of @@ -87,12 +87,30 @@ verify_executable(Name0, [Ext|Rest]) -> %% on Unix, since we test if any execution bit is set. {ok, Name1}; _ -> - verify_executable(Name0, Rest) + verify_executable(Name0, Rest, OrigExtensions) end end; -verify_executable(_, []) -> +verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows + %% Will only happen on windows, hence case insensitivity + case can_be_full_name(string:to_lower(Name),OrigExtensions) of + true -> + verify_executable(Name,[""],[""]); + _ -> + error + end; +verify_executable(_, [], _) -> error. +can_be_full_name(_Name,[]) -> + false; +can_be_full_name(Name,[H|T]) -> + case lists:suffix(H,Name) of %% Name is in lowercase, cause this is a windows thing + true -> + true; + _ -> + can_be_full_name(Name,T) + end. + split_path(Path) -> case type() of {win32, _} -> @@ -119,6 +137,7 @@ reverse_element(List) -> lists:reverse(List). -spec extensions() -> [string()]. +%% Extensions in lower case extensions() -> case type() of {win32, _} -> [".exe",".com",".cmd",".bat"]; diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 6a3534b094..ace9501d18 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -137,6 +137,13 @@ find_executable(Config) when is_list(Config) -> ?line find_exe(Abin, "my_ar", ".exe", Path), ?line find_exe(Abin, "my_ascii", ".com", Path), ?line find_exe(Abin, "my_adb", ".bat", Path), + %% OTP-3626 find names of executables given with extension + ?line find_exe(Abin, "my_ar.exe", "", Path), + ?line find_exe(Abin, "my_ascii.com", "", Path), + ?line find_exe(Abin, "my_adb.bat", "", Path), + ?line find_exe(Abin, "my_ar.EXE", "", Path), + ?line find_exe(Abin, "my_ascii.COM", "", Path), + ?line find_exe(Abin, "MY_ADB.BAT", "", Path), %% Search for programs in Abin (second element in PATH). ?line find_exe(Abin, "my_ar", ".exe", Path), diff --git a/lib/megaco/doc/src/megaco.xml b/lib/megaco/doc/src/megaco.xml index 0fb9d5aac6..ae9e250965 100644 --- a/lib/megaco/doc/src/megaco.xml +++ b/lib/megaco/doc/src/megaco.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2009</year> + <year>2000</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>megaco</title> @@ -40,6 +40,16 @@ <section> <title>DATA TYPES</title> <code type="none"><![CDATA[ +megaco_mid() = ip4Address() | ip6Address() | + domainName() | deviceName() | + mtpAddress() +ip4Address() = #'IP4Address'{} +ip6Address() = #'IP6Address'{} +domainName() = #'DomainName'{} +deviceName() = pathName() +pathName() = ia5String(1..64) +mtpAddress() = octetString(2..4) + action_request() = #'ActionRequest'{} action_reply() = #'ActionReply'{} error_desc() = #'ErrorDescriptor'{} diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index ab17dd50ca..99a3784402 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -66,6 +66,16 @@ <list type="bulleted"> <item> + <p>A raise condition when, during high load, processing + both the original and a resent message and delivering + this as two separate messages to the user. </p> + <p>Note that this solution only protects against multiple + reply deliveries! </p> + <p>Own Id: OTP-8529</p> + <p>Aux Id: Seq 10915</p> + </item> + + <item> <p>Fix shared libraries installation. </p> <p>The flex shared lib(s) were incorrectly installed as data files. </p> @@ -73,6 +83,13 @@ <p>Own Id: OTP-8627</p> </item> + <item> + <p>Eliminated a possible raise condition while creating + pending counters. </p> + <p>Own Id: OTP-8634</p> + <p>Aux Id: Seq 11579</p> + </item> + </list> </section> diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 5df31f2923..f939f5e6cf 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -133,13 +133,16 @@ [ {"3.14", [ + {load_module, megaco_messenger, soft_purge, soft_purge, [megaco_monitor]}, + {update, megaco_monitor, soft, soft_purge, soft_purge, []}, {update, megaco_config, soft, soft_purge, soft_purge, []} ] }, {"3.13", [ - {load_module, megaco_messenger, soft_purge, soft_purge, []}, + {load_module, megaco_messenger, soft_purge, soft_purge, [megaco_monitor]}, {load_module, megaco_filter, soft_purge, soft_purge, []}, + {update, megaco_monitor, soft, soft_purge, soft_purge, []}, {update, megaco_config, soft, soft_purge, soft_purge, []}, {update, megaco_flex_scanner_handler, {advanced, downgrade_to_pre_3_13_1}, soft_purge, soft_purge, []} @@ -173,13 +176,16 @@ [ {"3.14", [ + {load_module, megaco_messenger, soft_purge, soft_purge, [megaco_monitor]}, + {update, megaco_monitor, soft, soft_purge, soft_purge, []}, {update, megaco_config, soft, soft_purge, soft_purge, []} ] }, {"3.13", [ - {load_module, megaco_messenger, soft_purge, soft_purge, []}, + {load_module, megaco_messenger, soft_purge, soft_purge, [megaco_monitor]}, {load_module, megaco_filter, soft_purge, soft_purge, []}, + {update, megaco_monitor, soft, soft_purge, soft_purge, []}, {update, megaco_config, soft, soft_purge, soft_purge, []}, {update, megaco_flex_scanner_handler, {advanced, upgrade_from_pre_3_13_1}, soft_purge, soft_purge, []} diff --git a/lib/megaco/src/app/megaco_internal.hrl b/lib/megaco/src/app/megaco_internal.hrl index adbaacacef..2c124e9060 100644 --- a/lib/megaco/src/app/megaco_internal.hrl +++ b/lib/megaco/src/app/megaco_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -139,6 +139,22 @@ [?APPLICATION, ?MODULE, self()|A]))). +-define(megaco_ereport(Label, Report), + ?megaco_report(error_report, Label, Report)). + +-define(megaco_wreport(Label, Report), + ?megaco_report(warning_report, Label, Report)). + +-define(megaco_ireport(Label, Report), + ?megaco_report(info_report, Label, Report)). + +-define(megaco_report(Func, Label, Report), + (catch error_logger:Func([{label, Label}, + {application, ?APPLICATION}, + {module, ?MODULE}, + {process, self()} | Report]))). + + %%%---------------------------------------------------------------------- %%% Default (ignore) value of the Extra argument to the %%% megaco:receive_message/5 and process_received_message functions/5. diff --git a/lib/megaco/src/engine/megaco_config.erl b/lib/megaco/src/engine/megaco_config.erl index 0445f10838..6805db790d 100644 --- a/lib/megaco/src/engine/megaco_config.erl +++ b/lib/megaco/src/engine/megaco_config.erl @@ -628,31 +628,19 @@ incr_counter(Item, Incr) -> end catch error:_ -> + %% Counter does not exist, so try creat it try begin cre_counter(Item, Incr) end catch exit:_ -> - %% Ok, some other process got there before us, - %% so try again + %% This is a raise condition. + %% When we tried to update the counter above, it + %% did not exist, but now it does... ets:update_counter(megaco_config, Item, Incr) end end. -%% incr_counter(Item, Incr) -> -%% case (catch ets:update_counter(megaco_config, Item, Incr)) of -%% {'EXIT', _} -> -%% case (catch cre_counter(Item, Incr)) of -%% {'EXIT', _} -> -%% %% Ok, some other process got there before us, -%% %% so try again -%% ets:update_counter(megaco_config, Item, Incr); -%% NewVal -> -%% NewVal -%% end; -%% NewVal -> -%% NewVal -%% end. cre_counter(Item, Initial) -> case whereis(?SERVER) =:= self() of @@ -660,8 +648,8 @@ cre_counter(Item, Initial) -> case call({cre_counter, Item, Initial}) of {ok, Value} -> Value; - Error -> - exit(Error) + {error, Reason} -> + exit({failed_creating_counter, Item, Initial, Reason}) end; true -> %% Check that the counter does not already exists @@ -671,7 +659,7 @@ cre_counter(Item, Initial) -> ets:insert(megaco_config, {Item, Initial}), {ok, Initial}; [_] -> - %% Ouch, now what? + %% Possibly a raise condition {error, already_exists} end diff --git a/lib/megaco/src/engine/megaco_messenger.erl b/lib/megaco/src/engine/megaco_messenger.erl index 5756e8e896..5fad29931b 100644 --- a/lib/megaco/src/engine/megaco_messenger.erl +++ b/lib/megaco/src/engine/megaco_messenger.erl @@ -1541,30 +1541,6 @@ check_pending_limit(Limit, Direction, TransId) -> aborted end. -%% check_pending_limit(infinity, _, _) -> -%% {ok, 0}; -%% check_pending_limit(Limit, Direction, TransId) -> -%% ?rt2("check pending limit", [Direction, Limit, TransId]), -%% case (catch megaco_config:get_pending_counter(Direction, TransId)) of -%% {'EXIT', _} -> -%% %% This function is only called when we "know" the -%% %% counter to exist. So, the only reason that this -%% %% would happen is of the counter has been removed. -%% %% This only happen if the pending limit has been -%% %% reached. In any case, this is basically the same -%% %% as aborted! -%% ?rt2("check pending limit - exit", []), -%% aborted; -%% Val when Val =< Limit -> -%% %% Since we have no intention to increment here, it -%% %% is ok to be _at_ the limit -%% ?rt2("check pending limit - ok", [Val]), -%% {ok, Val}; -%% _Val -> -%% ?rt2("check pending limit - aborted", [_Val]), -%% aborted -%% end. - check_and_maybe_incr_pending_limit(infinity, _, _) -> ok; @@ -1572,59 +1548,42 @@ check_and_maybe_incr_pending_limit(Limit, Direction, TransId) -> %% %% We need this kind of test to detect when we _pass_ the limit %% - ?rt2("check and maybe incr pending limit", [Direction, Limit, TransId]), + ?rt2("check and maybe incr pending limit", [{direction, Direction}, + {transaction_id, TransId}, + {counter_limit, Limit}]), try megaco_config:get_pending_counter(Direction, TransId) of Val when Val > Limit -> - ?rt2("check and maybe incr - aborted", [Direction, Val, Limit]), + ?rt2("check and maybe incr - aborted", [{counter_value, Val}]), aborted; % Already passed the limit Val -> - ?rt2("check and maybe incr - incr", [Direction, Val, Limit]), + ?rt2("check and maybe incr - incr", [{counter_value, Val}]), megaco_config:incr_pending_counter(Direction, TransId), if Val < Limit -> ok; % Still within the limit true -> ?rt2("check and maybe incr - error", - [Direction, Val, Limit]), + [{counter_value, Val}]), error % Passed the limit end catch _:_ -> %% Has not been created yet (connect). - megaco_config:cre_pending_counter(Direction, TransId, 1), - ok + %% Try create it, but bevare of possible raise condition + try + begin + megaco_config:cre_pending_counter(Direction, TransId, 1), + ok + end + catch + _:_ -> + %% Ouch, raise condition, increment instead... + megaco_config:incr_pending_counter(Direction, TransId), + ok + end end. -%% check_and_maybe_incr_pending_limit(infinity, _, _) -> -%% ok; -%% check_and_maybe_incr_pending_limit(Limit, Direction, TransId) -> -%% %% -%% %% We need this kind of test to detect when we _pass_ the limit -%% %% -%% ?rt2("check and maybe incr pending limit", [Direction, Limit, TransId]), -%% case (catch megaco_config:get_pending_counter(Direction, TransId)) of -%% {'EXIT', _} -> -%% %% Has not been created yet (connect). -%% megaco_config:cre_pending_counter(Direction, TransId, 1), -%% ok; -%% Val when Val > Limit -> -%% ?rt2("check and maybe incr - aborted", [Direction, Val, Limit]), -%% aborted; % Already passed the limit -%% Val -> -%% ?rt2("check and maybe incr - incr", [Direction, Val, Limit]), -%% megaco_config:incr_pending_counter(Direction, TransId), -%% if -%% Val < Limit -> -%% ok; % Still within the limit -%% true -> -%% ?rt2("check and maybe incr - error", -%% [Direction, Val, Limit]), -%% error % Passed the limit -%% end -%% end. - - %% BUGBUG BUGBUG BUGBUG %% %% Do we know that the Rep is still valid? A previous transaction @@ -2648,33 +2607,84 @@ handle_reply( handle_reply(#conn_data{conn_handle = CH} = CD, T, Extra) -> TransId = to_local_trans_id(CD), ?rt2("handle reply", [T, TransId]), - case megaco_monitor:lookup_request(TransId) of - [Req] when (is_record(Req, request) andalso - (CD#conn_data.cancel =:= true)) -> + case {megaco_monitor:request_lockcnt_inc(TransId), + megaco_monitor:lookup_request(TransId)} of + {_Cnt, [Req]} when (is_record(Req, request) andalso + (CD#conn_data.cancel =:= true)) -> ?TC_AWAIT_REPLY_EVENT(true), + ?report_trace(CD, "trans reply - cancel(1)", [T]), do_handle_reply_cancel(CD, Req, T); - [#request{remote_mid = RMid} = Req] when ((RMid =:= preliminary_mid) orelse - (RMid =:= CH#megaco_conn_handle.remote_mid)) -> + {Cnt, [#request{remote_mid = RMid} = Req]} when + ((Cnt =:= 1) andalso + ((RMid =:= preliminary_mid) orelse + (RMid =:= CH#megaco_conn_handle.remote_mid))) -> + ?TC_AWAIT_REPLY_EVENT(false), + %% Just in case conn_data got update after our lookup + %% but before we looked up the request record, we + %% check the cancel field again. + case megaco_config:conn_info(CD, cancel) of + true -> + ?report_trace(CD, "trans reply - cancel(2)", [T]), + megaco_monitor:request_lockcnt_del(TransId), + do_handle_reply_cancel(CD, Req, T); + false -> + ?report_trace(CD, "trans reply", [T]), + do_handle_reply(CD, Req, TransId, T, Extra) + end; + + {Cnt, [#request{remote_mid = RMid} = _Req]} when + (is_integer(Cnt) andalso + ((RMid =:= preliminary_mid) orelse + (RMid =:= CH#megaco_conn_handle.remote_mid))) -> + ?TC_AWAIT_REPLY_EVENT(false), + %% Ok, someone got there before me, now what? + %% This is a plain old raise condition + ?report_important(CD, "trans reply - raise condition", + [T, {request_lockcnt, Cnt}]), + megaco_monitor:request_lockcnt_dec(TransId); + + %% no counter + {_Cnt, [#request{remote_mid = RMid} = Req]} when + ((RMid =:= preliminary_mid) orelse + (RMid =:= CH#megaco_conn_handle.remote_mid)) -> ?TC_AWAIT_REPLY_EVENT(false), + %% The counter does not exist. + %% This can only mean a code upgrade raise condition. + %% That is, this request record was created before + %% this feature (the counters) was instroduced. + %% The simples solution is this is to behave exactly as + %% before, that is pass it along, and leave it to the + %% user to figure out. + %% Just in case conn_data got update after our lookup %% but before we looked up the request record, we %% check the cancel field again. + ?report_verbose(CD, "trans reply - old style", [T]), case megaco_config:conn_info(CD, cancel) of true -> + megaco_monitor:request_lockcnt_del(TransId), do_handle_reply_cancel(CD, Req, T); false -> do_handle_reply(CD, Req, TransId, T, Extra) end; - [#request{user_mod = UserMod, - user_args = UserArgs, - reply_action = Action, - reply_data = UserData, - remote_mid = RMid}] -> + {Cnt, [#request{user_mod = UserMod, + user_args = UserArgs, + reply_action = Action, + reply_data = UserData, + remote_mid = RMid}]} -> ?report_trace(CD, "received trans reply with invalid remote mid", - [T, RMid]), + [{transaction, T}, + {remote_mid, RMid}, + {request_lockcnt, Cnt}]), + if + is_integer(Cnt) -> + megaco_monitor:request_lockcnt_dec(TransId); + true -> + ok + end, WrongMid = CH#megaco_conn_handle.remote_mid, T2 = transform_transaction_reply_enc(CD#conn_data.protocol_version, T), @@ -2685,7 +2695,15 @@ handle_reply(#conn_data{conn_handle = CH} = CD, T, Extra) -> reply_data = UserData}, return_reply(CD2, TransId, UserReply, Extra); - [] -> + {Cnt, []} when is_integer(Cnt) -> + ?TC_AWAIT_REPLY_EVENT(undefined), + ?report_trace(CD, "trans reply (no receiver)", + [T, {request_lockcnt, Cnt}]), + megaco_monitor:request_lockcnt_dec(TransId), + return_unexpected_trans(CD, T, Extra); + + %% No counter + {_Cnt, []} -> ?TC_AWAIT_REPLY_EVENT(undefined), ?report_trace(CD, "trans reply (no receiver)", [T]), return_unexpected_trans(CD, T, Extra) @@ -2716,6 +2734,7 @@ do_handle_reply(CD, %% This is the first reply (maybe of many) megaco_monitor:delete_request(TransId), + megaco_monitor:request_lockcnt_del(TransId), megaco_monitor:cancel_apply_after(Ref), % OTP-4843 megaco_config:del_pending_counter(recv, TransId), % OTP-7189 @@ -3739,6 +3758,11 @@ insert_requests(ConnData, ConnHandle, insert_request(ConnData, ConnHandle, TransId, Action, Data, InitTimer, LongTimer) -> + %% We dont check the result of the lock-counter creation because + %% the only way it could already exist is if the transaction-id + %% range has wrapped and an old counter was not deleted. + megaco_monitor:request_lockcnt_cre(TransId), + #megaco_conn_handle{remote_mid = RemoteMid} = ConnHandle, #conn_data{protocol_version = Version, user_mod = UserMod, @@ -4323,6 +4347,7 @@ cancel_request(ConnData, Req, Reason) -> cancel_request2(ConnData, TransId, UserReply) -> megaco_monitor:delete_request(TransId), + megaco_monitor:request_lockcnt_del(TransId), megaco_config:del_pending_counter(recv, TransId), % OTP-7189 Serial = TransId#trans_id.serial, ConnData2 = ConnData#conn_data{serial = Serial}, @@ -4380,29 +4405,67 @@ receive_reply_remote(ConnData, UserReply) -> receive_reply_remote(ConnData, UserReply, Extra) -> TransId = to_local_trans_id(ConnData), - case (catch megaco_monitor:lookup_request(TransId)) of - [#request{timer_ref = {_Type, Ref}} = Req] -> %% OTP-4843 + case {megaco_monitor:request_lockcnt_inc(TransId), + (catch megaco_monitor:lookup_request(TransId))} of + {Cnt, [Req]} when (Cnt =:= 1) andalso is_record(Req, request) -> %% Don't care about Req and Rep version diff - megaco_monitor:delete_request(TransId), - megaco_monitor:cancel_apply_after(Ref), % OTP-4843 - megaco_config:del_pending_counter(recv, TransId), % OTP-7189 - - UserMod = Req#request.user_mod, - UserArgs = Req#request.user_args, - Action = Req#request.reply_action, - UserData = Req#request.reply_data, - ConnData2 = ConnData#conn_data{user_mod = UserMod, - user_args = UserArgs, - reply_action = Action, - reply_data = UserData}, - return_reply(ConnData2, TransId, UserReply, Extra); - + do_receive_reply_remote(ConnData, TransId, Req, UserReply, Extra); + + {Cnt, [Req]} when is_integer(Cnt) andalso is_record(Req, request) -> + %% Another process is accessing, handle as unexpected + %% (so it has a possibillity to get logged). + ?report_important(ConnData, "trans reply (no receiver)", + [{user_reply, UserReply}, + {request_lockcnt, Cnt}]), + megaco_monitor:request_lockcnt_dec(TransId), + return_unexpected_trans_reply(ConnData, TransId, UserReply, Extra); + + %% no counter + {_Cnt, [Req]} when is_record(Req, request) -> + %% The counter does not exist. + %% This can only mean a code upgrade raise condition. + %% That is, this request record was created before + %% this feature (the counters) was instroduced. + %% The simples solution to this is to behave exactly as + %% before, that is, pass it along, and leave it to the + %% user to figure out. + ?report_trace(ConnData, + "remote reply - " + "code upgrade raise condition", + [{user_reply, UserReply}]), + do_receive_reply_remote(ConnData, TransId, Req, UserReply, Extra); + + {Cnt, _} when is_integer(Cnt) -> + ?report_trace(ConnData, "trans reply (no receiver)", + [{user_reply, UserReply}, {request_lockcnt, Cnt}]), + megaco_monitor:request_lockcnt_dec(TransId), + return_unexpected_trans_reply(ConnData, TransId, UserReply, Extra); + _ -> ?report_trace(ConnData, "remote reply (no receiver)", - [UserReply]), + [{user_reply, UserReply}]), return_unexpected_trans_reply(ConnData, TransId, UserReply, Extra) end. +do_receive_reply_remote(ConnData, TransId, + #request{timer_ref = {_Type, Ref}, + user_mod = UserMod, + user_args = UserArgs, + reply_action = Action, + reply_data = UserData} = _Req, + UserReply, Extra) -> + megaco_monitor:delete_request(TransId), + megaco_monitor:request_lockcnt_del(TransId), + megaco_monitor:cancel_apply_after(Ref), % OTP-4843 + megaco_config:del_pending_counter(recv, TransId), % OTP-7189 + + ConnData2 = ConnData#conn_data{user_mod = UserMod, + user_args = UserArgs, + reply_action = Action, + reply_data = UserData}, + return_reply(ConnData2, TransId, UserReply, Extra). + + cancel_reply(ConnData, #reply{state = waiting_for_ack, user_mod = UserMod, user_args = UserArgs} = Rep, Reason) -> diff --git a/lib/megaco/src/engine/megaco_monitor.erl b/lib/megaco/src/engine/megaco_monitor.erl index f95a20cf58..29275371be 100644 --- a/lib/megaco/src/engine/megaco_monitor.erl +++ b/lib/megaco/src/engine/megaco_monitor.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -51,6 +51,11 @@ update_request_field/3, update_request_fields/2, delete_request/1, + request_lockcnt_cre/1, + request_lockcnt_del/1, + request_lockcnt_inc/1, + request_lockcnt_dec/1, + lookup_reply/1, lookup_reply_field/2, match_replies/1, @@ -115,6 +120,24 @@ update_request_fields(Key, NewFields) when is_list(NewFields) -> delete_request(Key) -> ets:delete(megaco_requests, Key). + +request_lockcnt_cre(TransId) -> + Key = {TransId, lockcnt}, + ets:insert_new(megaco_requests, {Key, 1}). + +request_lockcnt_del(TransId) -> + Key = {TransId, lockcnt}, + ets:delete(megaco_requests, Key). + +request_lockcnt_inc(TransId) -> + Key = {TransId, lockcnt}, + (catch ets:update_counter(megaco_requests, Key, 1)). + +request_lockcnt_dec(TransId) -> + Key = {TransId, lockcnt}, + (catch ets:update_counter(megaco_requests, Key, -1)). + + lookup_reply(Key) -> ets:lookup(megaco_replies, Key). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index cf5957460d..cab3a1a4e0 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -19,10 +19,10 @@ APPLICATION = megaco MEGACO_VSN = 3.14.1 -PRE_VSN = +PRE_VSN =-p03 APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" -TICKETS = OTP-8561 OTP-8627 +TICKETS = OTP-8529 OTP-8561 OTP-8627 OTP-8634 TICKETS_3_14 = OTP-8317 OTP-8323 OTP-8328 OTP-8362 OTP-8403 diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 2bcacc0990..c0cf440496 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -313,7 +313,7 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { dsa-with-sha1 SIGNATURE-ALGORITHM-CLASS ::= { ID id-dsa-with-sha1 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE Dss-Parms } -- -- RSA Keys and Signatures diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 2764ea2e43..e3b6ffa125 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -327,7 +327,7 @@ window_change(Tty, OldTty, Buf) {[], Buf}; window_change(Tty, OldTty, {Buf, BufTail, Col}) -> M1 = move_cursor(Col, 0, OldTty), - N = max(Tty#ssh_pty.width - OldTty#ssh_pty.width, 0) * 2, + N = erlang:max(Tty#ssh_pty.width - OldTty#ssh_pty.width, 0) * 2, S = lists:reverse(Buf, [BufTail | lists:duplicate(N, $ )]), M2 = move_cursor(length(Buf) + length(BufTail) + N, Col, Tty), {[M1, S | M2], {Buf, BufTail, Col}}. @@ -398,10 +398,6 @@ nthtail(0, A) -> A; nthtail(N, [_ | A]) when N > 0 -> nthtail(N-1, A); nthtail(_, _) -> []. -%%% utils -max(A, B) when A > B -> A; -max(_A, B) -> B. - ifelse(Cond, A, B) -> case Cond of true -> A; diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 822ef8f8f9..d46002c494 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -527,7 +527,7 @@ handle_info({Protocol, Socket, Data}, Statename, %% Implementations SHOULD decrypt the length after receiving the %% first 8 (or cipher block size, whichever is larger) bytes of a %% packet. (RFC 4253: Section 6 - Binary Packet Protocol) - case size(EncData0) + size(Data) >= max(8, BlockSize) of + case size(EncData0) + size(Data) >= erlang:max(8, BlockSize) of true -> {Ssh, SshPacketLen, DecData, EncData} = @@ -758,11 +758,6 @@ after_new_keys(#state{renegotiate = false, ssh_params = #ssh{role = server}} = State) -> {userauth, State}. -max(N, M) when N > M -> - N; -max(_, M) -> - M. - handle_ssh_packet_data(RemainingSshPacketLen, DecData, EncData, StateName, State) -> EncSize = size(EncData), diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index a38b7639d8..18c467db81 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -95,8 +95,9 @@ forms([F | Fs0], St0) -> forms([], St) -> {[],St}. clauses([{clause,Line,H0,G0,B0} | Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), + {H1,St1} = head(H0, St0), + {G1,St2} = guard(G0, St1), + {H,G} = optimize_is_record(H1, G1), {B,St3} = exprs(B0, St2), {Cs,St4} = clauses(Cs0, St3), {[{clause,Line,H,G,B} | Cs],St4}; @@ -800,5 +801,132 @@ imported(F, A, St) -> error -> no end. +%%% +%%% Replace is_record/3 in guards with matching if possible. +%%% + +optimize_is_record(H0, G0) -> + case opt_rec_vars(G0) of + [] -> + {H0,G0}; + Rs0 -> + {H,Rs} = opt_pattern_list(H0, Rs0), + G = opt_remove(G0, Rs), + {H,G} + end. + + +%% opt_rec_vars(Guards) -> Vars. +%% Search through the guard expression, looking for +%% variables referenced in those is_record/3 calls that +%% will fail the entire guard if they evaluate to 'false' +%% +%% In the following code +%% +%% f(X, Y, Z) when is_record(X, r1) andalso +%% (is_record(Y, r2) orelse is_record(Z, r3)) +%% +%% the entire guard will be false if the record test for +%% X fails, and the clause can be rewritten to: +%% +%% f({r1,...}=X, Y, Z) when true andalso +%% (is_record(Y, r2) or is_record(Z, r3)) +%% +opt_rec_vars([G|Gs]) -> + Rs = opt_rec_vars_1(G, orddict:new()), + opt_rec_vars(Gs, Rs); +opt_rec_vars([]) -> orddict:new(). + +opt_rec_vars([G|Gs], Rs0) -> + Rs1 = opt_rec_vars_1(G, orddict:new()), + Rs = ordsets:intersection(Rs0, Rs1), + opt_rec_vars(Gs, Rs); +opt_rec_vars([], Rs) -> Rs. + +opt_rec_vars_1([T|Ts], Rs0) -> + Rs = opt_rec_vars_2(T, Rs0), + opt_rec_vars_1(Ts, Rs); +opt_rec_vars_1([], Rs) -> Rs. + +opt_rec_vars_2({op,_,'and',A1,A2}, Rs) -> + opt_rec_vars_1([A1,A2], Rs); +opt_rec_vars_2({op,_,'andalso',A1,A2}, Rs) -> + opt_rec_vars_1([A1,A2], Rs); +opt_rec_vars_2({op,_,'orelse',Arg,{atom,_,fail}}, Rs) -> + %% Since the second argument guarantees failure, + %% it is safe to inspect the first argument. + opt_rec_vars_2(Arg, Rs); +opt_rec_vars_2({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}}, + [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) -> + orddict:store(V, {Tag,Sz}, Rs); +opt_rec_vars_2({call,_,{atom,_,is_record}, + [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}, Rs) -> + orddict:store(V, {Tag,Sz}, Rs); +opt_rec_vars_2(_, Rs) -> Rs. + +opt_pattern_list(Ps, Rs) -> + opt_pattern_list(Ps, Rs, []). + +opt_pattern_list([P0|Ps], Rs0, Acc) -> + {P,Rs} = opt_pattern(P0, Rs0), + opt_pattern_list(Ps, Rs, [P|Acc]); +opt_pattern_list([], Rs, Acc) -> + {reverse(Acc),Rs}. + +opt_pattern({var,_,V}=Var, Rs0) -> + case orddict:find(V, Rs0) of + {ok,{Tag,Sz}} -> + Rs = orddict:store(V, {remove,Tag,Sz}, Rs0), + {opt_var(Var, Tag, Sz),Rs}; + _ -> + {Var,Rs0} + end; +opt_pattern({cons,Line,H0,T0}, Rs0) -> + {H,Rs1} = opt_pattern(H0, Rs0), + {T,Rs} = opt_pattern(T0, Rs1), + {{cons,Line,H,T},Rs}; +opt_pattern({tuple,Line,Es0}, Rs0) -> + {Es,Rs} = opt_pattern_list(Es0, Rs0), + {{tuple,Line,Es},Rs}; +opt_pattern({match,Line,Pa0,Pb0}, Rs0) -> + {Pa,Rs1} = opt_pattern(Pa0, Rs0), + {Pb,Rs} = opt_pattern(Pb0, Rs1), + {{match,Line,Pa,Pb},Rs}; +opt_pattern(P, Rs) -> {P,Rs}. + +opt_var({var,Line,_}=Var, Tag, Sz) -> + Rp = record_pattern(2, -1, ignore, Sz, Line, [{atom,Line,Tag}]), + {match,Line,{tuple,Line,Rp},Var}. + +opt_remove(Gs, Rs) -> + [opt_remove_1(G, Rs) || G <- Gs]. + +opt_remove_1(Ts, Rs) -> + [opt_remove_2(T, Rs) || T <- Ts]. + +opt_remove_2({op,L,'and'=Op,A1,A2}, Rs) -> + {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)}; +opt_remove_2({op,L,'andalso'=Op,A1,A2}, Rs) -> + {op,L,Op,opt_remove_2(A1, Rs),opt_remove_2(A2, Rs)}; +opt_remove_2({op,L,'orelse',A1,A2}, Rs) -> + {op,L,'orelse',opt_remove_2(A1, Rs),A2}; +opt_remove_2({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}}, + [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) -> + case orddict:find(V, Rs) of + {ok,{remove,Tag,Sz}} -> + {atom,Line,true}; + _ -> + A + end; +opt_remove_2({call,Line,{atom,_,is_record}, + [{var,_,V},{atom,_,Tag},{integer,_,Sz}]}=A, Rs) -> + case orddict:find(V, Rs) of + {ok,{remove,Tag,Sz}} -> + {atom,Line,true}; + _ -> + A + end; +opt_remove_2(A, _) -> A. + neg_line(L) -> erl_parse:set_line(L, fun(Line) -> -abs(Line) end). diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 2471c545dd..f78d8dc609 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -238,6 +238,7 @@ bif(binary_to_existing_atom, 2) -> true; bif(binary_to_list, 1) -> true; bif(binary_to_list, 3) -> true; bif(binary_to_term, 1) -> true; +bif(binary_to_term, 2) -> true; bif(bitsize, 1) -> true; bif(bit_size, 1) -> true; bif(bitstring_to_list, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 94ad560549..2cc5c6a5ac 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -242,10 +242,10 @@ format_error({untyped_record,T}) -> format_error({unbound_var,V}) -> io_lib:format("variable ~w is unbound", [V]); format_error({unsafe_var,V,{What,Where}}) -> - io_lib:format("variable ~w unsafe in ~w ~s", + io_lib:format("variable ~w unsafe in ~w ~s", [V,What,format_where(Where)]); format_error({exported_var,V,{What,Where}}) -> - io_lib:format("variable ~w exported from ~w ~s", + io_lib:format("variable ~w exported from ~w ~s", [V,What,format_where(Where)]); format_error({shadowed_var,V,In}) -> io_lib:format("variable ~w shadowed in ~w", [V,In]); @@ -296,16 +296,16 @@ format_error({unused_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]); format_error({new_builtin_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is a new builtin type; " - "its (re)definition is allowed only until the next release", + "its (re)definition is allowed only until the next release", [TypeName, gen_type_paren(Arity)]); format_error({builtin_type, {TypeName, Arity}}) -> - io_lib:format("type ~w~s is a builtin type; it cannot be redefined", + io_lib:format("type ~w~s is a builtin type; it cannot be redefined", [TypeName, gen_type_paren(Arity)]); format_error({renamed_type, OldName, NewName}) -> io_lib:format("type ~w() is now called ~w(); " "please use the new name instead", [OldName, NewName]); format_error({redefine_type, {TypeName, Arity}}) -> - io_lib:format("type ~w~s already defined", + io_lib:format("type ~w~s already defined", [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); @@ -354,7 +354,7 @@ pseudolocals() -> %% %% Used by erl_eval.erl to check commands. -%% +%% exprs(Exprs, BindingsList) -> exprs_opt(Exprs, BindingsList, []). @@ -362,7 +362,7 @@ exprs_opt(Exprs, BindingsList, Opts) -> {St0,Vs} = foldl(fun({{record,_SequenceNumber,_Name},Attr0}, {St1,Vs1}) -> Attr = zip_file_and_line(Attr0, "none"), {attribute_state(Attr, St1),Vs1}; - ({V,_}, {St1,Vs1}) -> + ({V,_}, {St1,Vs1}) -> {St1,[{V,{bound,unused,[]}} | Vs1]} end, {start("nofile",Opts),[]}, BindingsList), Vt = orddict:from_list(Vs), @@ -391,7 +391,7 @@ module(Forms) -> Opts = compiler_options(Forms), St = forms(Forms, start("nofile", Opts)), return_status(St). - + module(Forms, FileName) -> Opts = compiler_options(Forms), St = forms(Forms, start(FileName, Opts)), @@ -506,7 +506,7 @@ pack_errors(Es) -> %% Sort on line number. pack_warnings(Ws) -> - [{File,lists:sort([W || {F,W} <- Ws, F =:= File])} || + [{File,lists:sort([W || {F,W} <- Ws, F =:= File])} || File <- lists:usort([F || {F,_} <- Ws])]. %% add_error(ErrorDescriptor, State) -> State' @@ -516,13 +516,13 @@ pack_warnings(Ws) -> add_error(E, St) -> St#lint{errors=[{St#lint.file,E}|St#lint.errors]}. -add_error(FileLine, E, St) -> +add_error(FileLine, E, St) -> {File,Location} = loc(FileLine), add_error({Location,erl_lint,E}, St#lint{file = File}). add_warning(W, St) -> St#lint{warnings=[{St#lint.file,W}|St#lint.warnings]}. -add_warning(FileLine, W, St) -> +add_warning(FileLine, W, St) -> {File,Location} = loc(FileLine), add_warning({Location,erl_lint,W}, St#lint{file = File}). @@ -561,7 +561,7 @@ pre_scan([_ | Fs], St) -> pre_scan(Fs, St); pre_scan([], St) -> St. - + includes_qlc_hrl(Forms, St) -> %% QLC calls erl_lint several times, sometimes with the compile %% attribute removed. The file attribute, however, is left as is. @@ -735,12 +735,12 @@ is_bif_clash(Name, Arity, #lint{clashes=Clashes}) -> not_deprecated(Forms, St0) -> %% There are no line numbers in St0#lint.compile. - MFAsL = [{MFA,L} || + MFAsL = [{MFA,L} || {attribute, L, compile, Args} <- Forms, {nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]), MFA <- lists:flatten([MFAs0])], Nowarn = [MFA || {MFA,_L} <- MFAsL], - Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL, + Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL, otp_internal:obsolete(M, F, A) =:= no], St1 = func_line_warning(bad_nowarn_deprecated_function, Bad, St0), St1#lint{not_deprecated = ordsets:from_list(Nowarn)}. @@ -862,7 +862,7 @@ check_deprecated(Forms, St0) -> Bad = [{E,L} || {attribute, L, deprecated, Depr} <- Forms, D <- lists:flatten([Depr]), E <- depr_cat(D, X, Mod)], - foldl(fun ({E,L}, St1) -> + foldl(fun ({E,L}, St1) -> add_error(L, E, St1) end, St0, Bad). @@ -912,7 +912,7 @@ check_imports(Forms, St0) -> true -> Usage = St0#lint.usage, Unused = ordsets:subtract(St0#lint.imports, Usage#usage.imported), - Imports = [{{FA,list_to_atom(package_to_string(Mod))},L} + Imports = [{{FA,list_to_atom(package_to_string(Mod))},L} || {attribute,L,import,{Mod,Fs}} <- Forms, FA <- lists:usort(Fs)], Bad = [{FM,L} || FM <- Unused, {FM2,L} <- Imports, FM =:= FM2], @@ -932,7 +932,7 @@ check_unused_functions(Forms, St0) -> Opts = St1#lint.compile, case member(export_all, Opts) orelse not is_warn_enabled(unused_function, St1) of - true -> + true -> St1; false -> Nowarn = nowarn_function(nowarn_unused_function, Opts), @@ -1008,7 +1008,7 @@ check_option_functions(Forms, Tag0, Type, St0) -> func_line_error(Type, Bad, St0). nowarn_function(Tag, Opts) -> - ordsets:from_list([FA || {Tag1,FAs} <- Opts, + ordsets:from_list([FA || {Tag1,FAs} <- Opts, Tag1 =:= Tag, FA <- lists:flatten([FAs])]). @@ -1048,10 +1048,10 @@ check_unused_records(Forms, St0) -> %% functions count. Usage = St0#lint.usage, UsedRecords = sets:to_list(Usage#usage.used_records), - URecs = foldl(fun (Used, Recs) -> - dict:erase(Used, Recs) + URecs = foldl(fun (Used, Recs) -> + dict:erase(Used, Recs) end, St0#lint.records, UsedRecords), - Unused = [{Name,FileLine} || + Unused = [{Name,FileLine} || {Name,{FileLine,_Fields}} <- dict:to_list(URecs), element(1, loc(FileLine)) =:= FirstFile], foldl(fun ({N,L}, St) -> @@ -1061,14 +1061,14 @@ check_unused_records(Forms, St0) -> St0 end. -%% For storing the import list we use the orddict module. +%% For storing the import list we use the orddict module. %% We know an empty set is []. %% export(Line, Exports, State) -> State. %% Mark functions as exported, also as called from the export line. export(Line, Es, #lint{exports = Es0, called = Called} = St0) -> - {Es1,C1,St1} = + {Es1,C1,St1} = foldl(fun (NA, {E,C,St2}) -> St = case gb_sets:is_element(NA, E) of true -> @@ -1196,7 +1196,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func}=St) -> is_function_exported(Name, Arity, #lint{exports=Exports,compile=Compile}) -> gb_sets:is_element({Name,Arity}, Exports) orelse member(export_all, Compile). - + %% function(Line, Name, Arity, Clauses, State) -> State. function(Line, instance, _Arity, _Cs, St) when St#lint.global_vt =/= [] -> @@ -1258,7 +1258,7 @@ head([P|Ps], Vt, Old, St0) -> {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt1,Bvt2),St2}; head([], _Vt, _Env, St) -> {[],[],St}. -%% pattern(Pattern, VarTable, Old, BinVarTable, State) -> +%% pattern(Pattern, VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,BinVarTable,State}. %% Check pattern return variables. Old is the set of variables used for %% deciding whether an occurrence is a binding occurrence or a use, and @@ -1276,7 +1276,7 @@ pattern(P, Vt, St) -> pattern({var,_Line,'_'}, _Vt, _Old, _Bvt, St) -> {[],[],St}; %Ignore anonymous variable -pattern({var,Line,V}, _Vt, Old, Bvt, St) -> +pattern({var,Line,V}, _Vt, Old, Bvt, St) -> pat_var(V, Line, Old, Bvt, St); pattern({char,_Line,_C}, _Vt, _Old, _Bvt, St) -> {[],[],St}; pattern({integer,_Line,_I}, _Vt, _Old, _Bvt, St) -> {[],[],St}; @@ -1294,7 +1294,7 @@ pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> - {Vt1,St1} = + {Vt1,St1} = check_record(Line, Name, St, fun (Dfs, St1) -> pattern_field(Field, Name, Dfs, St1) @@ -1309,7 +1309,7 @@ pattern({record_field,Line,_,_}=M, _Vt, _Old, _Bvt, St0) -> end; pattern({record,Line,Name,Pfs}, Vt, Old, Bvt, St) -> case dict:find(Name, St#lint.records) of - {ok,{_Line,Fields}} -> + {ok,{_Line,Fields}} -> St1 = used_record(Name, St), pattern_fields(Pfs, Name, Fields, Vt, Old, Bvt, St1); error -> {[],[],add_error(Line, {undefined_record,Name}, St)} @@ -1369,7 +1369,7 @@ reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) -> reject_bin_alias(T1, T2, St); reject_bin_alias({tuple,_,Es1}, {tuple,_,Es2}, St) -> reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, +reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, #lint{records=Recs}=St) -> case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> @@ -1451,7 +1451,7 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) -> erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]); is_pattern_expr_1(_Other) -> false. -%% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> +%% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,UpdBinVarTable,State}. %% Check a pattern group. BinVarTable are used binsize variables. @@ -1498,7 +1498,7 @@ good_string_size_type(default, Ts) -> end, Ts); good_string_size_type(_, _) -> false. -%% pat_bit_expr(Pattern, OldVarTable, BinVarTable,State) -> +%% pat_bit_expr(Pattern, OldVarTable, BinVarTable,State) -> %% {UpdVarTable,UpdBinVarTable,State}. %% Check pattern bit expression, only allow really valid patterns! @@ -1513,7 +1513,7 @@ pat_bit_expr(P, _Old, _Bvt, St) -> false -> {[],[],add_error(element(2, P), illegal_pattern, St)} end. -%% pat_bit_size(Size, VarTable, BinVarTable, State) -> +%% pat_bit_size(Size, VarTable, BinVarTable, State) -> %% {Value,UpdVarTable,UpdBinVarTable,State}. %% Check pattern size expression, only allow really valid sizes! @@ -1596,7 +1596,7 @@ bit_size_check(Line, Size, #bittype{type=Type,unit=Unit}, St) -> Sz = Unit * Size, %Total number of bits! St2 = elemtype_check(Line, Type, Sz, St), {Sz,St2}. - + elemtype_check(_Line, float, 32, St) -> St; elemtype_check(_Line, float, 64, St) -> St; elemtype_check(Line, float, _Size, St) -> @@ -1710,7 +1710,7 @@ gexpr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> gexpr({call,Line,{atom,_Lr,is_record},[E,R]}, Vt, St0) -> {Asvt,St1} = gexpr_list([E,R], Vt, St0), {Asvt,add_error(Line, illegal_guard_expr, St1)}; -gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, +gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, Vt, St0) -> gexpr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0); gexpr({call,_Line,{atom,_Lr,is_record},[E,{atom,_,_Name},{integer,_,_}]}, @@ -1777,7 +1777,7 @@ is_guard_test(E) -> %% is_guard_test(Expression, Forms) -> boolean(). is_guard_test(Expression, Forms) -> RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms], - St0 = foldl(fun(Attr0, St1) -> + St0 = foldl(fun(Attr0, St1) -> Attr = zip_file_and_line(Attr0, "none"), attribute_state(Attr, St1) end, start(), RecordAttributes), @@ -1798,7 +1798,7 @@ is_guard_test2(G, RDs) -> %% is_guard_expr(Expression) -> boolean(). %% Test if an expression is a guard expression. -is_guard_expr(E) -> is_gexpr(E, []). +is_guard_expr(E) -> is_gexpr(E, []). is_gexpr({var,_L,_V}, _RDs) -> true; is_gexpr({char,_L,_C}, _RDs) -> true; @@ -1820,7 +1820,7 @@ is_gexpr({record_field,_L,Rec,_Name,Field}, RDs) -> is_gexpr({record,L,Name,Inits}, RDs) -> is_gexpr_fields(Inits, L, Name, RDs); is_gexpr({bin,_L,Fs}, RDs) -> - all(fun ({bin_element,_Line,E,Sz,_Ts}) -> + all(fun ({bin_element,_Line,E,Sz,_Ts}) -> is_gexpr(E, RDs) and (Sz =:= default orelse is_gexpr(Sz, RDs)) end, Fs); is_gexpr({call,_L,{atom,_Lf,F},As}, RDs) -> @@ -1902,8 +1902,8 @@ expr({record_index,Line,Name,Field}, _Vt, St) -> fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end); expr({record,Line,Name,Inits}, Vt, St) -> check_record(Line, Name, St, - fun (Dfs, St1) -> - init_fields(Inits, Line, Name, Dfs, Vt, St1) + fun (Dfs, St1) -> + init_fields(Inits, Line, Name, Dfs, Vt, St1) end); expr({record_field,Line,_,_}=M, _Vt, St0) -> case expand_package(M, St0) of @@ -1969,7 +1969,7 @@ expr({'fun',Line,Body}, Vt, St) -> expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), {Rvt,exist_record(Ln, Name, St1)}; -expr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, +expr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, Vt, St0) -> expr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0); expr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,is_record}]},As}, Vt, St) -> @@ -1995,7 +1995,7 @@ expr({call,Line,{atom,La,F},As}, Vt, St0) -> case erl_internal:bif(F, A) of true -> St3 = deprecated_function(Line, erlang, F, As, St2), - {Asvt,case is_warn_enabled(bif_clash, St3) andalso + {Asvt,case is_warn_enabled(bif_clash, St3) andalso is_bif_clash(F, A, St3) of false -> St3; @@ -2155,7 +2155,7 @@ def_fields(Fs0, Name, St0) -> foldl(fun ({record_field,Lf,{atom,La,F},V}, {Fs,St}) -> case exist_field(F, Fs) of true -> {Fs,add_error(Lf, {redefine_field,Name,F}, St)}; - false -> + false -> St1 = St#lint{recdef_top = true}, {_,St2} = expr(V, [], St1), %% Warnings and errors found are kept, but @@ -2306,7 +2306,7 @@ init_fields(Ifs, Line, Name, Dfs, Vt0, St0) -> Defs = init_fields(Ifs, Line, Dfs), {_,St2} = check_fields(Defs, Name, Dfs, Vt1, St1, fun expr/3), {Vt1,St1#lint{usage = St2#lint.usage}}. - + ginit_fields(Ifs, Line, Name, Dfs, Vt0, St0) -> {Vt1,St1} = check_fields(Ifs, Name, Dfs, Vt0, St0, fun gexpr/3), Defs = init_fields(Ifs, Line, Dfs), @@ -2316,7 +2316,7 @@ ginit_fields(Ifs, Line, Name, Dfs, Vt0, St0) -> IllErrs = [E || {_File,{_Line,erl_lint,illegal_guard_expr}}=E <- Errors], St4 = St1#lint{usage = Usage, errors = IllErrs ++ St1#lint.errors}, {Vt1,St4}. - + %% Default initializations to be carried out init_fields(Ifs, Line, Dfs) -> [ {record_field,Lf,{atom,La,F},copy_expr(Di, Line)} || @@ -2394,7 +2394,7 @@ check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); -check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, +check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, SeenVars, #lint{module=CurrentMod} = St) -> St1 = case (dict:is_key({Name, length(Args)}, default_types()) @@ -2432,7 +2432,7 @@ check_type({type, L, 'fun', [Dom, Range]}, SeenVars, St) -> check_type({type, -1, product, [Dom, Range]}, SeenVars, St1); check_type({type, L, range, [From, To]}, SeenVars, St) -> St1 = - case {From, To} of + case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, X}, {integer, _, Y}} when X < Y -> St; _ -> add_error(L, {type_syntax, range}, St) end, @@ -2441,8 +2441,8 @@ check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, L, binary, [Base, Unit]}, SeenVars, St) -> St1 = - case {Base, Unit} of - {{integer, _, BaseVal}, + case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of + {{integer, _, BaseVal}, {integer, _, UnitVal}} when BaseVal >= 0, UnitVal >= 0 -> St; _ -> add_error(L, {type_syntax, binary}, St) end, @@ -2467,7 +2467,13 @@ check_type({type, La, TypeName, Args}, SeenVars, #lint{usage=Usage} = St) -> UsedTypes = dict:store({TypeName, Arity}, La, OldUsed), St#lint{usage=Usage#usage{used_types=UsedTypes}} end, - check_type({type, -1, product, Args}, SeenVars, St1). + check_type({type, -1, product, Args}, SeenVars, St1); +check_type(I, SeenVars, St) -> + case erl_eval:partial_eval(I) of + {integer,_ILn,_Integer} -> {SeenVars, St}; + _Other -> + {SeenVars, add_error(element(2, I), {type_syntax, integer}, St)} + end. check_record_types(Line, Name, Fields, SeenVars, St) -> case dict:find(Name, St#lint.records) of @@ -2475,12 +2481,12 @@ check_record_types(Line, Name, Fields, SeenVars, St) -> case lists:all(fun({type, _, field_type, _}) -> true; (_) -> false end, Fields) of - true -> + true -> check_record_types(Fields, Name, DefFields, SeenVars, St, []); false -> {SeenVars, add_error(Line, {type_syntax, record}, St)} end; - error -> + error -> {SeenVars, add_error(Line, {undefined_record, Name}, St)} end. @@ -2606,7 +2612,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of - {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> + {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> Types0 = [T || {type, _, constraint, [_, T]} <- Cs], {FT, lists:append(Types0)}; {type, _, 'fun', _} = FT -> {FT, []} @@ -2679,7 +2685,7 @@ check_unused_types(Forms, St = #lint{usage=Usage, types=Types}) -> {FirstFile, _} -> case dict:is_key(Type, UsedTypes) of true -> AccSt; - false -> + false -> add_warning(FileLine, {unused_type, Type}, AccSt) @@ -2834,7 +2840,7 @@ fun_clause({clause,_Line,H,G,B}, Vt0, St0) -> %% %% used variable has been used %% unused variable has been bound but not used -%% +%% %% Lines is a list of line numbers where the variable was bound. %% %% Report variable errors/warnings as soon as possible and then change @@ -2864,9 +2870,9 @@ pat_var(V, Line, Vt, Bvt, St) -> case orddict:find(V, Bvt) of {ok, {bound,_Usage,Ls}} -> {[],[{V,{bound,used,Ls}}],St}; - error -> + error -> case orddict:find(V, Vt) of - {ok,{bound,_Usage,Ls}} -> + {ok,{bound,_Usage,Ls}} -> {[{V,{bound,used,Ls}}],[],St}; {ok,{{unsafe,In},_Usage,Ls}} -> {[{V,{bound,used,Ls}}],[], @@ -2919,7 +2925,7 @@ pat_binsize_var(V, Line, Vt, Bvt, St) -> expr_var(V, Line, Vt, St0) -> case orddict:find(V, Vt) of - {ok,{bound,_Usage,Ls}} -> + {ok,{bound,_Usage,Ls}} -> {[{V,{bound,used,Ls}}],St0}; {ok,{{unsafe,In},_Usage,Ls}} -> {[{V,{bound,used,Ls}}], @@ -2957,7 +2963,7 @@ check_old_unused_vars(Vt, Vt0, St0) -> warn_unused_vars(U, Vt, St0). unused_vars(Vt, Vt0, _St0) -> - U0 = orddict:filter(fun (V, {_State,unused,_Ls}) -> + U0 = orddict:filter(fun (V, {_State,unused,_Ls}) -> case atom_to_list(V) of "_"++_ -> false; _ -> true @@ -2973,7 +2979,7 @@ warn_unused_vars(U, Vt, St0) -> false -> St0; true -> foldl(fun ({V,{_,unused,Ls}}, St) -> - foldl(fun (L, St2) -> + foldl(fun (L, St2) -> add_warning(L, {unused_var,V}, St2) end, St, Ls) @@ -3073,7 +3079,7 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, -ifdef(NOTUSED). vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)). -vunion(Vss) -> foldl(fun (Vs, Uvs) -> +vunion(Vss) -> foldl(fun (Vs, Uvs) -> ordsets:union(vtnames(Vs), Uvs) end, [], Vss). @@ -3103,7 +3109,7 @@ modify_line(T, F0) -> %% Forms. modify_line1({function,F,A}, _Mf) -> {function,F,A}; modify_line1({function,M,F,A}, _Mf) -> {function,M,F,A}; -modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> +modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; @@ -3118,7 +3124,7 @@ modify_line1({warning,W}, _Mf) -> {warning,W}; modify_line1({error,W}, _Mf) -> {error,W}; %% Expressions. modify_line1({clauses,Cs}, Mf) -> {clauses,modify_line1(Cs, Mf)}; -modify_line1({typed_record_field,Field,Type}, Mf) -> +modify_line1({typed_record_field,Field,Type}, Mf) -> {typed_record_field,modify_line1(Field, Mf),modify_line1(Type, Mf)}; modify_line1({Tag,L}, Mf) -> {Tag,Mf(L)}; modify_line1({Tag,L,E1}, Mf) -> @@ -3154,7 +3160,7 @@ check_record_info_call(Line,_La,_As,St) -> has_wildcard_field([{record_field,_Lf,{var,_La,'_'},_Val}|_Fs]) -> true; has_wildcard_field([_|Fs]) -> has_wildcard_field(Fs); has_wildcard_field([]) -> false. - + %% check_remote_function(Line, ModuleName, FuncName, [Arg], State) -> State. %% Perform checks on known remote calls. @@ -3170,7 +3176,7 @@ check_remote_function(Line, M, F, As, St0) -> check_qlc_hrl(Line, M, F, As, St) -> Arity = length(As), case As of - [{lc,_L,_E,_Qs}|_] when M =:= qlc, F =:= q, + [{lc,_L,_E,_Qs}|_] when M =:= qlc, F =:= q, Arity < 3, not St#lint.xqlc -> add_warning(Line, {missing_qlc_hrl, Arity}, St); _ -> @@ -3355,11 +3361,11 @@ extract_sequence(3, [$.,_|Fmt], Need) -> extract_sequence(4, Fmt, Need); extract_sequence(3, Fmt, Need) -> extract_sequence(4, Fmt, Need); -extract_sequence(4, [$t, $c | Fmt], Need) -> - extract_sequence(5, [$c|Fmt], Need); -extract_sequence(4, [$t, $s | Fmt], Need) -> - extract_sequence(5, [$s|Fmt], Need); -extract_sequence(4, [$t, C | _Fmt], _Need) -> +extract_sequence(4, [$t, $c | Fmt], Need) -> + extract_sequence(5, [$c|Fmt], Need); +extract_sequence(4, [$t, $s | Fmt], Need) -> + extract_sequence(5, [$s|Fmt], Need); +extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 141ee18afd..bb4b18cf9b 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -47,7 +47,7 @@ opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type top_type top_type_100 top_types type typed_expr typed_attr_val type_sig type_sigs type_guard type_guards fun_type fun_type_100 binary_type type_spec spec_fun typed_exprs typed_record_fields field_types field_type -bin_base_type bin_unit_type int_type. +bin_base_type bin_unit_type type_200 type_300 type_400 type_500. Terminals char integer float atom string var @@ -120,8 +120,24 @@ top_types -> top_type ',' top_types : ['$1'|'$3']. top_type -> var '::' top_type_100 : {ann_type, ?line('$1'), ['$1','$3']}. top_type -> top_type_100 : '$1'. -top_type_100 -> type : '$1'. -top_type_100 -> type '|' top_type_100 : lift_unions('$1','$3'). +top_type_100 -> type_200 : '$1'. +top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3'). + +type_200 -> type_300 '..' type_300 : {type, ?line('$1'), range, + [skip_paren('$1'), + skip_paren('$3')]}. +type_200 -> type_300 : '$1'. + +type_300 -> type_300 add_op type_400 : ?mkop2(skip_paren('$1'), + '$2', skip_paren('$3')). +type_300 -> type_400 : '$1'. + +type_400 -> type_400 mult_op type_500 : ?mkop2(skip_paren('$1'), + '$2', skip_paren('$3')). +type_400 -> type_500 : '$1'. + +type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')). +type_500 -> type : '$1'. type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. type -> var : '$1'. @@ -143,16 +159,10 @@ type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. type -> '#' atom '{' field_types '}' : {type, ?line('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. -type -> int_type : '$1'. -type -> int_type '..' int_type : {type, ?line('$1'), range, - ['$1', '$3']}. +type -> integer : '$1'. type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. -int_type -> integer : '$1'. -int_type -> '-' integer : abstract(-normalise('$2'), - ?line('$2')). - fun_type_100 -> '(' '...' ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), any}, '$5']}. @@ -180,9 +190,9 @@ binary_type -> '<<' bin_unit_type '>>' : {type, ?line('$1'),binary, binary_type -> '<<' bin_base_type ',' bin_unit_type '>>' : {type, ?line('$1'), binary, ['$2', '$4']}. -bin_base_type -> var ':' integer : build_bin_type(['$1'], '$3'). +bin_base_type -> var ':' type : build_bin_type(['$1'], '$3'). -bin_unit_type -> var ':' var '*' integer : build_bin_type(['$1', '$3'], '$5'). +bin_unit_type -> var ':' var '*' type : build_bin_type(['$1', '$3'], '$5'). attr_val -> expr : ['$1']. attr_val -> expr ',' exprs : ['$1' | '$3']. @@ -607,6 +617,11 @@ lift_unions(T1, {type, _La, union, List}) -> lift_unions(T1, T2) -> {type, ?line(T1), union, [T1, T2]}. +skip_paren({paren_type,_L,[Type]}) -> + skip_paren(Type); +skip_paren(Type) -> + Type. + build_gen_type({atom, La, tuple}) -> {type, La, tuple, any}; build_gen_type({atom, La, Name}) -> @@ -615,7 +630,7 @@ build_gen_type({atom, La, Name}) -> build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); build_bin_type([], Int) -> - Int; + skip_paren(Int); build_bin_type([{var, La, _}|_], _) -> ret_err(La, "Bad binary type"). diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 0859bf0466..df4a20b833 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -115,7 +115,7 @@ lattribute({attribute,_Line,Name,Arg}, Hook) -> lattribute(module, {M,Vs}, _Hook) -> attr("module",[{var,0,pname(M)}, - foldr(fun(V, C) -> {cons,0,{var,0,V},C} + foldr(fun(V, C) -> {cons,0,{var,0,V},C} end, {nil,0}, Vs)]); lattribute(module, M, _Hook) -> attr("module", [{var,0,pname(M)}]); @@ -140,7 +140,7 @@ typeattr(Tag, {TypeName,Type,Args}, _Hook) -> ltype({ann_type,_Line,[V,T]}) -> typed(lexpr(V, none), T); ltype({paren_type,_Line,[T]}) -> - [$(,ltype(T),$)]; + [$(,ltype(T),$)]; ltype({type,_Line,union,Ts}) -> {seq,[],[],[' |'],ltypes(Ts)}; ltype({type,_Line,list,[T]}) -> @@ -153,7 +153,7 @@ ltype({type,Line,tuple,any}) -> simple_type({atom,Line,tuple}, []); ltype({type,_Line,tuple,Ts}) -> tuple_type(Ts, fun ltype/1); -ltype({type,_Line,record,[N|Fs]}) -> +ltype({type,_Line,record,[{atom,_,N}|Fs]}) -> record_type(N, Fs); ltype({type,_Line,range,[_I1,_I2]=Es}) -> expr_list(Es, '..', fun lexpr/2, none); @@ -174,12 +174,15 @@ ltype({atom,_,T}) -> ltype(E) -> lexpr(E, 0, none). -binary_type({integer,_,Int1}=I1, {integer,_,Int2}=I2) -> - E1 = [[leaf("_:"),lexpr(I1, 0, none)] || Int1 =/= 0], - E2 = [[leaf("_:_*"),lexpr(I2, 0, none)] || Int2 =/= 0], +binary_type(I1, I2) -> + B = [[] || {integer,_,0} <- [I1]] =:= [], + U = [[] || {integer,_,0} <- [I2]] =:= [], + P = max_prec(), + E1 = [[leaf("_:"),lexpr(I1, P, none)] || B], + E2 = [[leaf("_:_*"),lexpr(I2, P, none)] || U], {seq,'<<','>>',[$,],E1++E2}. -record_type({atom,_,Name}, Fields) -> +record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. field_types(Fs) -> @@ -443,7 +446,7 @@ lexpr({op,_,Op,Arg}, Prec, Hook) -> Ol = leaf(format("~s ", [Op])), El = [Ol,lexpr(Arg, R, Hook)], maybe_paren(P, Prec, El); -lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) when Op =:= 'orelse'; +lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) when Op =:= 'orelse'; Op =:= 'andalso' -> %% Breaks lines since R12B. {L,P,R} = inop_prec(Op), @@ -727,15 +730,15 @@ frmt(Item, I) -> %%% and indentation are inserted between IPs. %%% - {first,I,IP2}: IP2 follows after I, and is output with an indentation %%% updated with the width of I. -%%% - {seq,Before,After,Separator,IPs}: a sequence of Is separated by -%%% Separator. Before is output before IPs, and the indentation of IPs +%%% - {seq,Before,After,Separator,IPs}: a sequence of Is separated by +%%% Separator. Before is output before IPs, and the indentation of IPs %%% is updated with the width of Before. After follows after IPs. %%% - {force_nl,ExtraInfo,I}: fun-info (a comment) forces linebreak before I. %%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative %%% indentation. %%% - {string,S}: a string. %%% - {hook,...}, {ehook,...}: hook expressions. -%%% +%%% %%% list, first, seq, force_nl, and prefer_nl all accept IPs, where each %%% element is either an item or a tuple {step|cstep,I1,I2}. step means %%% that I2 is output after linebreak and an incremented indentation. @@ -761,7 +764,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT) -> {CharsL,SizeL} = unz(CharsSizeL), {BCharsL,BSizeL} = unz1([BCharsSize]), Sizes = BSizeL ++ SizeL, - NSepChars = if + NSepChars = if is_list(Sep), Sep =/= [] -> erlang:max(0, length(CharsL)-1); true -> @@ -876,7 +879,7 @@ nl_indent(I, T) when I > 0 -> [$\n|spaces(I, T)]. same_line(I0, SizeL, NSepChars) -> - try + try Size = lists:sum(SizeL) + NSepChars, true = incr(I0, Size) =< ?MAXLINE, {yes,Size} @@ -956,9 +959,9 @@ write_a_string(S, N, Len) -> -define(N_SPACES, 30). spacetab() -> - {[_|L],_} = mapfoldl(fun(_, A) -> {A,[$\s|A]} + {[_|L],_} = mapfoldl(fun(_, A) -> {A,[$\s|A]} end, [], lists:seq(0, ?N_SPACES)), - list_to_tuple(L). + list_to_tuple(L). spaces(N, T) when N =< ?N_SPACES -> element(N, T); @@ -966,7 +969,7 @@ spaces(N, T) -> [element(?N_SPACES, T)|spaces(N-?N_SPACES, T)]. wordtable() -> - L = [begin {leaf,Sz,S} = leaf(W), {S,Sz} end || + L = [begin {leaf,Sz,S} = leaf(W), {S,Sz} end || W <- [" ->"," =","<<",">>","[]","after","begin","case","catch", "end","fun","if","of","receive","try","when"," ::","..", " |"]], diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 66730b7b94..c57541fba9 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -46,7 +46,7 @@ neg_indent/1, tickets/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, - otp_8473/1, otp_8522/1, otp_8567/1]). + otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1]). %% Internal export. -export([ehook/6]). @@ -765,7 +765,7 @@ neg_indent(Config) when is_list(Config) -> tickets(suite) -> [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, - otp_8567]. + otp_8567, otp_8664]. otp_6321(doc) -> "OTP_6321. Bug fix of exprs()."; @@ -995,6 +995,38 @@ otp_8567(Config) when is_list(Config) -> ok. +otp_8664(doc) -> + "OTP_8664. Types with integer expressions."; +otp_8664(suite) -> []; +otp_8664(Config) when is_list(Config) -> + FileName = filename('otp_8664.erl', Config), + C1 = <<"-module(otp_8664).\n" + "-export([t/0]).\n" + "-define(A, -3).\n" + "-define(B, (?A*(-1 band (((2)))))).\n" + "-type t1() :: ?B | ?A.\n" + "-type t2() :: ?B-1 .. -?B.\n" + "-type t3() :: 9 band (8 - 3) | 1+2 | 5 band 3.\n" + "-type b1() :: <<_:_*(3-(-1))>>\n" + " | <<_:(-(?B))>>\n" + " | <<_:4>>.\n" + "-type u() :: 1 .. 2 | 3.. 4 | (8-3) ..6 | 5+0..6.\n" + "-type t() :: t1() | t2() | t3() | b1() | u().\n" + "-spec t() -> t().\n" + "t() -> 3.\n">>, + ?line ok = file:write_file(FileName, C1), + ?line {ok, _, []} = compile:file(FileName, [return]), + + C2 = <<"-module(otp_8664).\n" + "-export([t/0]).\n" + "-spec t() -> 9 and 4.\n" + "t() -> 0.\n">>, + ?line ok = file:write_file(FileName, C2), + ?line {error,[{_,[{3,erl_lint,{type_syntax,integer}}]}],_} = + compile:file(FileName, [return]), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index aa12ed57da..e21de8770a 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -3184,7 +3184,9 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,b},{2,3}])">>, - {warnings,[{{3,48},qlc,nomatch_filter}]}}, + {warnings,[{2,sys_core_fold,nomatch_guard}, + {3,qlc,nomatch_filter}, + {3,sys_core_fold,{eval_failure,badarg}}]}}, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), element(1,{X}) =:= 1]), diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile index 0028df247c..8533488463 100644 --- a/lib/tools/emacs/Makefile +++ b/lib/tools/emacs/Makefile @@ -42,6 +42,7 @@ EMACS_FILES= \ erlang_appwiz \ erlang-start \ erlang-eunit \ + erlang-flymake \ erlang README_FILES= README diff --git a/lib/tools/emacs/README b/lib/tools/emacs/README index ca068d04c4..cc107dcd41 100644 --- a/lib/tools/emacs/README +++ b/lib/tools/emacs/README @@ -42,7 +42,14 @@ Files\erl-<Ver>: (setq erlang-root-dir "C:/Program Files/erl<Ver>") (setq exec-path (cons "C:/Program Files/erl<Ver>/bin" exec-path)) (require 'erlang-start) - +Miscellaneous addons +-------------------- + +In order to check erlang source code on the fly, add the following +line to your .emacs file (after erlang-start, see above). See +erlang-flymake.el for more information on how to customize the syntax +check. + (require 'erlang-flymake) diff --git a/lib/tools/emacs/erlang-flymake.el b/lib/tools/emacs/erlang-flymake.el new file mode 100644 index 0000000000..bc368e9454 --- /dev/null +++ b/lib/tools/emacs/erlang-flymake.el @@ -0,0 +1,102 @@ +;; erlang-flymake.el +;; +;; Syntax check erlang source code on the fly (integrates with flymake). +;; +;; Start using flymake with erlang by putting the following somewhere +;; in your .emacs file: +;; +;; (require 'erlang-flymake) +;; +;; Flymake is rather eager and does its syntax checks frequently by +;; default and if you are bothered by this, you might want to put the +;; following in your .emacs as well: +;; +;; (erlang-flymake-only-on-save) +;; +;; There are a couple of variables which control the compilation options: +;; * erlang-flymake-get-code-path-dirs-function +;; * erlang-flymake-get-include-dirs-function +;; * erlang-flymake-extra-opts +;; +;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang. + +(require 'flymake) +(eval-when-compile + (require 'cl)) + +(defvar erlang-flymake-command + "erlc" + "The command that will be used to perform the syntax check") + +(defvar erlang-flymake-get-code-path-dirs-function + 'erlang-flymake-get-code-path-dirs + "Return a list of ebin directories to add to the code path.") + +(defvar erlang-flymake-get-include-dirs-function + 'erlang-flymake-get-include-dirs + "Return a list of include directories to add to the compiler options.") + +(defvar erlang-flymake-extra-opts + (list "+warn_obsolete_guard" + "+warn_unused_import" + "+warn_shadow_vars" + "+warn_export_vars" + "+strong_validation" + "+report") + "A list of options that will be passed to the compiler") + +(defun erlang-flymake-only-on-save () + "Trigger flymake only when the buffer is saved (disables syntax +check on newline and when there are no changes)." + (interactive) + ;; There doesn't seem to be a way of disabling this; set to the + ;; largest int available as a workaround (most-positive-fixnum + ;; equates to 8.5 years on my machine, so it ought to be enough ;-) ) + (setq flymake-no-changes-timeout most-positive-fixnum) + (setq flymake-start-syntax-check-on-newline nil)) + + +(defun erlang-flymake-get-code-path-dirs () + (list (concat (erlang-flymake-get-app-dir) "ebin"))) + +(defun erlang-flymake-get-include-dirs () + (list (concat (erlang-flymake-get-app-dir) "include"))) + +(defun erlang-flymake-get-app-dir () + (let ((src-path (file-name-directory (buffer-file-name)))) + (file-name-directory (directory-file-name src-path)))) + +(defun erlang-flymake-init () + (let* ((temp-file + (flet ((flymake-get-temp-dir () (erlang-flymake-temp-dir))) + (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-with-folder-structure))) + (code-dir-opts + (erlang-flymake-flatten + (mapcar (lambda (dir) (list "-pa" dir)) + (funcall erlang-flymake-get-code-path-dirs-function)))) + (inc-dir-opts + (erlang-flymake-flatten + (mapcar (lambda (dir) (list "-I" dir)) + (funcall erlang-flymake-get-include-dirs-function)))) + (compile-opts + (append inc-dir-opts + code-dir-opts + erlang-flymake-extra-opts))) + (list erlang-flymake-command (append compile-opts (list temp-file))))) + +(defun erlang-flymake-temp-dir () + ;; Squeeze the user's name in there in order to make sure that files + ;; for two users who are working on the same computer (like a linux + ;; box) don't collide + (format "%s/flymake-%s" temporary-file-directory user-login-name)) + +(defun erlang-flymake-flatten (list) + (apply #'append list)) + +(add-to-list 'flymake-allowed-file-name-masks + '("\\.erl\\'" erlang-flymake-init)) +(add-hook 'erlang-mode-hook 'flymake-mode) + +(provide 'erlang-flymake) +;; erlang-flymake ends here diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index c31f76025e..91acfdf2b6 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -659,24 +659,30 @@ resulting regexp is surrounded by \\_< and \\_>." (eval-and-compile (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols))) - (eval-and-compile (defvar erlang-predefined-types '("any" "arity" + "boolean" "byte" "char" "cons" "deep_string" + "iolist" "maybe_improper_list" + "module" "mfa" "nil" + "neg_integer" "none" "non_neg_integer" "nonempty_list" "nonempty_improper_list" "nonempty_maybe_improper_list" + "no_return" + "pos_integer" "string" + "term" "timeout") "Erlang type specs types")) @@ -2484,9 +2490,10 @@ Value is list (stack token-start token-type in-what)." ((looking-at "\\(of\\)[^_a-zA-Z0-9]") ;; Must handle separately, try X of -> catch (if (and stack (eq (car (car stack)) 'try)) - (let ((try-column (nth 2 (car stack)))) + (let ((try-column (nth 2 (car stack))) + (try-pos (nth 1 (car stack)))) (erlang-pop stack) - (erlang-push (list 'icr token try-column) stack)))) + (erlang-push (list 'icr try-pos try-column) stack)))) ((looking-at "\\(fun\\)[^_a-zA-Z0-9]") ;; Push a new layer if we are defining a `fun' @@ -2747,7 +2754,7 @@ Return nil if inside string, t if in a comment." ;; ;; `after' should be indented to the same level as the ;; corresponding receive. - (cond ((looking-at "\\(after\\|catch\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)") + (cond ((looking-at "\\(after\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)") (nth 2 stack-top)) ((looking-at "when[^_a-zA-Z0-9]") ;; Handling one when part @@ -2766,7 +2773,7 @@ Return nil if inside string, t if in a comment." ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\)[^_a-zA-Z0-9]")) (nth 2 (car (cdr stack)))) ;; Real indentation, where operators create extra indentation etc. - ((memq (car stack-top) '(-> || begin try)) + ((memq (car stack-top) '(-> || try begin)) (if (looking-at "\\(of\\)[^_a-zA-Z0-9]") (nth 2 stack-top) (goto-char (nth 1 stack-top)) @@ -2795,19 +2802,24 @@ Return nil if inside string, t if in a comment." (erlang-caddr (car stack)) 0)) ((looking-at "catch\\($\\|[^_a-zA-Z0-9]\\)") - (if (or (eq (car stack-top) 'try) - (eq (car (car (cdr stack))) 'icr)) - (progn - (if (eq (car stack-top) '->) - (erlang-pop stack)) - (if stack - (erlang-caddr (car stack)) - 0)) - base)) ;; old catch + ;; Are we in a try + (let ((start (if (eq (car stack-top) '->) + (car (cdr stack)) + stack-top))) + (if (null start) nil + (goto-char (nth 1 start))) + (cond ((looking-at "try\\($\\|[^_a-zA-Z0-9]\\)") + (progn + (if (eq (car stack-top) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0))) + (t (erlang-indent-standard indent-point token base 'nil))))) ;; old catch (t (erlang-indent-standard indent-point token base 'nil) )))) - )) + )) ((eq (car stack-top) 'when) (goto-char (nth 1 stack-top)) (if (looking-at "when\\s *\\($\\|%\\)") @@ -2833,27 +2845,32 @@ Return nil if inside string, t if in a comment." (current-column))) ;; Type and Spec indentation ((eq (car stack-top) '::) - (cond ((null erlang-argument-indent) - ;; indent to next column. - (+ 2 (nth 2 stack-top))) - ((looking-at "::[^_a-zA-Z0-9]") - (nth 2 stack-top)) - (t - (let ((start-alternativ (if (looking-at "|") 2 0))) - (goto-char (nth 1 stack-top)) - (- (cond ((looking-at "::\\s *\\($\\|%\\)") - ;; Line ends with :: - (if (eq (car (car (last stack))) 'spec) + (if (looking-at "}") + ;; Closing record definition with types + ;; pop stack and recurse + (erlang-calculate-stack-indent indent-point + (cons (erlang-pop stack) (cdr state))) + (cond ((null erlang-argument-indent) + ;; indent to next column. + (+ 2 (nth 2 stack-top))) + ((looking-at "::[^_a-zA-Z0-9]") + (nth 2 stack-top)) + (t + (let ((start-alternativ (if (looking-at "|") 2 0))) + (goto-char (nth 1 stack-top)) + (- (cond ((looking-at "::\\s *\\($\\|%\\)") + ;; Line ends with :: + (if (eq (car (car (last stack))) 'spec) (+ (erlang-indent-find-preceding-expr 1) erlang-argument-indent) - (+ (erlang-indent-find-preceding-expr 2) - erlang-argument-indent))) - (t - ;; Indent to the same column as the first - ;; argument. - (goto-char (+ 2 (nth 1 stack-top))) - (skip-chars-forward " \t") - (current-column))) start-alternativ))))) + (+ (erlang-indent-find-preceding-expr 2) + erlang-argument-indent))) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (+ 2 (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column))) start-alternativ)))))) ))) (defun erlang-indent-standard (indent-point token base inside-parenthesis) diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index 1dc976d8dc..2948ccf1b5 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -93,11 +93,27 @@ -type t13() :: maybe_improper_list(integer(), t11()). -type t14() :: [erl_scan:foo() | %% Should be highlighted - non_neg_integer() | nonempty_list() | + term() | + bool() | + byte() | + char() | + non_neg_integer() | nonempty_list() | + pos_integer() | + neg_integer() | + number() | + list() | nonempty_improper_list() | nonempty_maybe_improper_list() | + maybe_improper_list() | string() | iolist() | byte() | + module() | + mfa() | + node() | + timeout() | + no_return() | %% Should not be highlighted nonempty_() | nonlist() | - erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. + erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. + + -type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>, <<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>| <<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>| @@ -172,6 +188,9 @@ f19 = 3 :: integer()|undefined, f5 = 3 :: undefined|integer()}). +-record(state, { + sequence_number = 1 :: integer() + }). highlighting(X) % Function definitions should be highlighted @@ -493,7 +512,9 @@ indent_try_catch() -> file:close(Xfile) end; indent_try_catch() -> - try foo(bar) of + try + foo(bar) + of X when true andalso kalle -> io:format(stdout, "Parsing file ~s, ", @@ -551,14 +572,57 @@ indent_catch() -> C = catch B + float(43.1), - case catch (X) of + case catch foo(X) of + A -> + B + end, + + case + catch foo(X) + of A -> B end, + + case + foo(X) + of + A -> + catch B, + X + end, + try sune of _ -> foo catch _:_ -> baf - end. + end, + + try + sune + of + _ -> + X = 5, + (catch foo(X)), + X + 10 + catch _:_ -> baf + end, + + try + (catch sune) + of + _ -> + catch foo() %% BUGBUG can't handle catch inside try without parentheses + catch _:_ -> + baf + end, + + try + (catch exit()) + catch + _ -> + catch baf() + end, + ok. indent_binary() -> X = lists:foldr(fun(M) -> diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index feb9e4e5a1..1221c5655e 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -93,11 +93,27 @@ -type t13() :: maybe_improper_list(integer(), t11()). -type t14() :: [erl_scan:foo() | %% Should be highlighted - non_neg_integer() | nonempty_list() | + term() | + bool() | + byte() | + char() | + non_neg_integer() | nonempty_list() | + pos_integer() | + neg_integer() | + number() | + list() | nonempty_improper_list() | nonempty_maybe_improper_list() | + maybe_improper_list() | string() | iolist() | byte() | + module() | + mfa() | + node() | + timeout() | + no_return() | %% Should not be highlighted nonempty_() | nonlist() | -erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. + erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. + + -type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>, <<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>| <<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>| @@ -172,6 +188,9 @@ f18 :: 1 | 2 | 'undefined', f19 = 3 :: integer()|undefined, f5 = 3 :: undefined|integer()}). +-record(state, { + sequence_number = 1 :: integer() + }). highlighting(X) % Function definitions should be highlighted @@ -493,7 +512,9 @@ indent_try_catch() -> file:close(Xfile) end; indent_try_catch() -> - try foo(bar) of + try + foo(bar) + of X when true andalso kalle -> io:format(stdout, "Parsing file ~s, ", @@ -551,14 +572,57 @@ indent_catch() -> C = catch B + float(43.1), - case catch (X) of + case catch foo(X) of A -> B end, + + case + catch foo(X) + of + A -> + B + end, + + case + foo(X) + of + A -> + catch B, + X + end, + try sune of - _ -> foo - catch _:_ -> baf - end. + _ -> foo + catch _:_ -> baf + end, + + try +sune + of + _ -> + X = 5, + (catch foo(X)), + X + 10 + catch _:_ -> baf + end, + + try + (catch sune) + of + _ -> + catch foo() %% BUGBUG can't handle catch inside try without parentheses + catch _:_ -> + baf + end, + + try +(catch exit()) + catch +_ -> + catch baf() + end, + ok. indent_binary() -> X = lists:foldr(fun(M) -> |