diff options
Diffstat (limited to 'lib')
46 files changed, 1597 insertions, 345 deletions
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index fdfcb08125..d54c2a9fde 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -209,6 +209,7 @@ btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs, D) -> btb_reaches_match_2([{apply,Arity}|Is], Regs, D) -> btb_call(Arity+2, apply, Regs, Is, D); btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) -> + btb_ensure_not_used([{x,Live}], I, Regs), btb_call(Live, I, Regs, Is, D); btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) -> btb_call(Live, make_fun2, Regs, Is, D); diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 97f84da08f..682f7adbc2 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -574,6 +574,7 @@ valfun_4({apply,Live}, Vst) -> valfun_4({apply_last,Live,_}, Vst) -> tail_call(apply, Live+2, Vst); valfun_4({call_fun,Live}, Vst) -> + validate_src([{x,Live}], Vst), call('fun', Live+1, Vst); valfun_4({call,Live,Func}, Vst) -> call(Func, Live, Vst); diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0bb4de6f17..5588f1fbe5 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -623,6 +623,7 @@ core_passes() -> [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, ?pass(core_fold_module), + {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, {core_fold_after_inlining,fun test_core_inliner/1,fun core_fold_module_after_inlining/1}, diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index f506901099..ed181e3baa 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -105,8 +105,8 @@ vu_expr(V, #c_cons{hd=H,tl=T}) -> vu_expr(V, H) orelse vu_expr(V, T); vu_expr(V, #c_tuple{es=Es}) -> vu_expr_list(V, Es); -vu_expr(V, #c_map{es=Es}) -> - vu_expr_list(V, Es); +vu_expr(V, #c_map{var=M,es=Es}) -> + vu_expr(V, M) orelse vu_expr_list(V, Es); vu_expr(V, #c_map_pair{key=Key,val=Val}) -> vu_expr_list(V, [Key,Val]); vu_expr(V, #c_binary{segments=Ss}) -> diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 9ce6bb48bf..e302e2324d 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1945,9 +1945,30 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> true -> cerl:values_es(E); false -> [E] end, - {true,Bs} = cerl_clauses:match_list(Ps0, Es), + %% Consider: + %% + %% case SomeSideEffect() of + %% X=Y -> ... + %% end + %% + %% We must not rewrite it to: + %% + %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ... + %% + %% because SomeSideEffect() would be called evaluated twice. + %% + %% Instead we must evaluate the case expression in an outer let + %% like this: + %% + %% let NewVar = SomeSideEffect() in + %% let <X,Y> = <NewVar,NewVar> in ... + %% + Vs = make_vars([], length(Es)), + {true,Bs} = cerl_clauses:match_list(Ps0, Vs), {Ps,As} = unzip(Bs), - expr(#c_let{vars=Ps,arg=core_lib:make_values(As),body=B}, sub_new(Sub)); + InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), + Let = cerl:c_let(Vs, E, InnerLet), + expr(Let, sub_new(Sub)); eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index c8735a76e8..4d155c0fd0 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -459,7 +459,7 @@ basic_block([Le|Les], Acc) -> %% sets that may garbage collect are not allowed in basic blocks. collect_block({set,_,{binary,_}}) -> no_block; -collect_block({set,_,{map,_,_}}) -> no_block; +collect_block({set,_,{map,_,_,_}}) -> no_block; collect_block({set,_,_}) -> include; collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; @@ -928,7 +928,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. @@ -1488,55 +1488,35 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; -set_cg([{var,R}], {map,SrcMap,Es0}, Le, Vdb, Bef, +set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, #cg{in_catch=InCatch,bfail=Bfail}=St) -> + Fail = {f,Bfail}, {Sis,Int0} = case InCatch of true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); false -> {[],Bef} end, + SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), - SrcReg = case SrcMap of - {var,SrcVar} -> fetch_var(SrcVar, Int0); - _ -> SrcMap - end, - {Assoc,Exact} = - try - cg_map_pairs(Es0) - catch - throw:badarg -> - {[],[{{float,0.0},{atom,badarg}}, - {{integer,0},{atom,badarg}}]} - end, - F = fun ({K,{var,V}}) -> [K,fetch_var(V, Int0)]; - ({K,E}) -> [K,E] - end, - AssocList = flatmap(F, Assoc), - ExactList = flatmap(F, Exact), - Live0 = max_reg(Bef#sr.reg), - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Bef#sr{reg=put_reg(R, Int1#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - Code = [Line] ++ - case {AssocList,ExactList} of - {[_|_],[]} -> - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}]; - {[_|_],[_|_]} -> - Live = case Target of - {x,TargetX} when TargetX =:= Live0 -> - Live0 + 1; - _ -> - Live0 - end, - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}, - {put_map_exact,Fail,Target,Target,Live,{list,ExactList}}]; - {[],[_|_]} -> - [{put_map_exact,Fail,SrcReg,Target,Live0,{list,ExactList}}]; - {[],[]} -> - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,[]}}] - end, - {Sis++Code,Aft,St}; + + %% The instruction needs to store keys in term sorted order + %% All keys has to be unique here + Pairs = map_pair_strip_and_termsort(Es), + + %% fetch registers for values to be put into the map + List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + + Live = max_reg(Bef#sr.reg), + Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, + Aft = clear_dead(Int1, Le#l.i, Vdb), + Target = fetch_reg(R, Int1#sr.reg), + + I = case Op of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1549,70 +1529,12 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -%% cg_map_pairs(MapPairs) -> {Assoc,Exact} -%% Assoc = Exact = [{K,V}] -%% -%% Remove multiple assignments to the same key, and return -%% one list key-value list with all keys that may or may not exist -%% (Assoc), and one with keys that must exist (Exact). -%% - -cg_map_pairs(Es0) -> - Es = cg_map_pairs_1(Es0, 0), - R0 = sofs:relation(Es), - R1 = sofs:relation_to_family(R0), - R2 = sofs:to_external(R1), - - %% R2 is now [{KeyValue,[{Order,Op,OriginalKey,Value}]}] - R3 = [begin - %% The value for the last pair determines the value. - {_,_,_,V} = lists:last(Vs), - {Op,{_,SortOrder}=K} = map_pair_op_and_key(Vs), - {Op,{SortOrder,K,V}} - end || {_,Vs} <- R2], - - %% R3 is now [{Op,{Key,Value}}] - R = termsort(R3), - - %% R4 is now sorted with all alloc first in the list, followed by - %% all exact. - {Assoc,Exact} = lists:partition(fun({Op,_}) -> Op =:= assoc end, R), - {[{K,V} || {_,{_,K,V}} <- Assoc], - [{K,V} || {_,{_,K,V}} <- Exact]}. - -cg_map_pairs_1([{map_pair_assoc,{_,Kv}=K,V}|T], Order) -> - [{Kv,{Order,assoc,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([{map_pair_exact,{_,Kv}=K,V}|T], Order) -> - [{Kv,{Order,exact,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([], _) -> []. - -%% map_pair_op_and_key({_,Op,K,_}) -> {Operator,Key} -%% Determine the operator and key to use. Throw a 'badarg' -%% exception if there are contradictory exact updates. - -map_pair_op_and_key(L) -> - case [K || {_,exact,K,_} <- L] of - [K] -> - %% There is a single ':=' operator. Use that key. - {exact,K}; - [K|T] -> - %% There is more than one ':=' operator. All of them - %% must have the same key. - case lists:all(fun(E) -> E =:= K end, T) of - true -> - {exact,K}; - false -> - %% Some keys are different, e.g. 1 and 1.0. - throw(badarg) - end; - [] -> - %% Only '=>' operators. Use the first key in the list. - [{_,assoc,K,_}|_] = L, - {assoc,K} - end. - -termsort(Ls) -> - lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Ls). +map_pair_strip_and_termsort(Es) -> + %% format in + %% [{map_pair,K,V}] + %% where K is for example {integer, 1} and we want to sort on 1. + Ls = [{K,V}||{_,K,V}<-Es], + lists:sort(fun({{_,A},_},{{_,B},_}) -> erts_internal:cmp_term(A,B) < 0 end, Ls). %%% %%% Code generation for constructing binaries. @@ -2085,7 +2007,7 @@ load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> ok{r{R}} | error. +%% find_reg(Val, Regs) -> {ok,r{R}} | error. %% fetch_reg(Val, Regs) -> r{R}. %% Functions to interface the registers. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 59863f52ec..291443f824 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -74,7 +74,7 @@ -export([module/2,format_error/1]). -import(lists, [reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3, - splitwith/2,keyfind/3,sort/1,foreach/2]). + splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). -import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]). @@ -226,13 +226,13 @@ guard(Gs0, St0) -> Gt1 = guard_tests(Gt0), L = element(2, Gt1), {op,L,'or',Gt1,Rhs} - end, guard_tests(last(Gs0)), first(Gs0)), + end, guard_tests(last(Gs0)), droplast(Gs0)), {Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}), {Gs,St#core{in_guard=false}}. guard_tests(Gs) -> L = element(2, hd(Gs)), - {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}. + {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), droplast(Gs))}. %% gexpr_top(Expr, State) -> {Cexpr,State}. %% Generate an internal core expression of a guard test. Explicitly @@ -513,7 +513,7 @@ expr({bin,L,Es0}, St0) -> end; expr({block,_,Es0}, St0) -> %% Inline the block directly. - {Es1,St1} = exprs(first(Es0), St0), + {Es1,St1} = exprs(droplast(Es0), St0), {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> @@ -1588,15 +1588,6 @@ pat_alias_list(_, _) -> throw(nomatch). pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. -%% first([A]) -> [A]. -%% last([A]) -> A. - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - -last([L]) -> L; -last([_|T]) -> last(T). - %% make_vars([Name]) -> [{Var,Name}]. make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. @@ -1679,13 +1670,13 @@ uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) -> uguard([], [], _, St) -> {[],St}; uguard(Pg, [], Ks, St) -> %% No guard, so fold together equality tests. - uguard(first(Pg), [last(Pg)], Ks, St); + uguard(droplast(Pg), [last(Pg)], Ks, St); uguard(Pg, Gs0, Ks, St0) -> %% Gs0 must contain at least one element here. {Gs3,St5} = foldr(fun (T, {Gs1,St1}) -> {L,St2} = new_var(St1), {R,St3} = new_var(St2), - {[#iset{var=L,arg=T}] ++ first(Gs1) ++ + {[#iset{var=L,arg=T}] ++ droplast(Gs1) ++ [#iset{var=R,arg=last(Gs1)}, #icall{anno=#a{}, %Must have an #a{} module=#c_literal{val=erlang}, diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 9a2b1605ad..bc5ca0314a 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,7 +81,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -274,8 +274,7 @@ expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> {#k_tuple{anno=A,es=Kes},Ep,St1}; expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) -> {Var,[],St1} = expr(Var0, Sub, St0), - {Kes,Ep,St2} = map_pairs(Ces, Sub, St1), - {#k_map{anno=A,var=Var,es=Kes},Ep,St2}; + map_split_pairs(A, Var, Ces, Sub, St1); expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -351,7 +350,7 @@ expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), Match = flatten_seq(build_match(Kvs, Km)), - {last(Match),Pa ++ Pv ++ first(Match),St3}; + {last(Match),Pa ++ Pv ++ droplast(Match),St3}; expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> {Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic! {Rvar,St2} = new_var(St1), @@ -497,15 +496,71 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. -%% FIXME: Not completed -map_pairs(Es, Sub, St) -> - foldr(fun - (#c_map_pair{op=#c_literal{val=Op},key=K0,val=V0}, {Kes,Esp,St0}) when - Op =:= assoc; Op =:= exact -> %% assert Op - {K,[],St1} = expr(K0, Sub, St0), - {V,Ep,St2} = atomic(V0, Sub, St1), - {[#k_map_pair{op=Op,key=K,val=V}|Kes],Ep ++ Esp,St2} - end, {[],[],St}, Es). + %{Kes,Ep,St2} = map_pairs(Ces, Sub, St1), +map_split_pairs(A, Var, Ces, Sub, St0) -> + %% two steps + %% 1. force variables + %% 2. remove multiples + Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces], + {Pairs,Esp,St1} = foldr(fun + ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact -> + {K,[],Sti1} = expr(K0, Sub, Sti0), + {V,Ep,Sti2} = atomic(V0, Sub, Sti1), + {[{Op,K,V}|Ops],Ep ++ Espi,Sti2} + end, {[],[],St0}, Pairs0), + + case map_group_pairs(Pairs) of + {Assoc,[]} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {#k_map{anno=A,op=assoc,var=Var,es=Kes},Esp,St1}; + {[],Exact} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Var,es=Kes},Esp,St1}; + {Assoc,Exact} -> + Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1), + Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Em ++ Esp,St2} + + end. + +%% Group map by Assoc operations and Exact operations + +map_group_pairs(Es) -> + Groups = dict:to_list(map_group_pairs(Es,dict:new())), + partition(fun({_,{Op,_,_}}) -> Op =:= assoc end, Groups). + +map_group_pairs([{assoc,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{assoc,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([{exact,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{exact,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([],Used) -> + Used. + +map_key_set_used(K,How,Used) -> + dict:store(map_key_clean(K),How,Used). + +map_key_is_used(K,Used) -> + dict:find(map_key_clean(K),Used). + +%% Be explicit instead of using set_kanno(K,[]) +map_key_clean(#k_literal{val=V}) -> {k_literal,V}; +map_key_clean(#k_int{val=V}) -> {k_int,V}; +map_key_clean(#k_float{val=V}) -> {k_float,V}; +map_key_clean(#k_atom{val=V}) -> {k_atom,V}; +map_key_clean(#k_nil{}) -> k_nil; +map_key_clean(#k_var{name=V}) -> {k_var,V}. + %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. @@ -664,11 +719,11 @@ pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) -> {#k_tuple{anno=A,es=Kes},Osub1,St1}; pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) -> {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), - {#k_map{anno=A,es=Kes},Osub1,St1}; + {#k_map{anno=A,op=exact,es=Kes},Osub1,St1}; pattern(#c_map_pair{op=#c_literal{val=exact},anno=A,key=Ck,val=Cv},Isub, Osub0, St0) -> {Kk,Osub1,St1} = pattern(Ck, Isub, Osub0, St0), {Kv,Osub2,St2} = pattern(Cv, Isub, Osub1, St1), - {#k_map_pair{anno=A,op=exact,key=Kk,val=Kv},Osub2,St2}; + {#k_map_pair{anno=A,key=Kk,val=Kv},Osub2,St2}; pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) -> {Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0), {#k_binary{anno=A,segs=Kv},Osub1,St1}; @@ -847,15 +902,6 @@ foldr2(Fun, Acc0, [E1|L1], [E2|L2]) -> foldr2(Fun, Acc1, L1, L2); foldr2(_, Acc, [], []) -> Acc. -%% first([A]) -> [A]. -%% last([A]) -> A. - -last([L]) -> L; -last([_|T]) -> last(T). - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1365,9 +1411,8 @@ new_clauses(Cs0, U, St) -> [S,N|As]; #k_bin_int{next=N} -> [N|As]; - #k_map{es=Es} -> - Vals = [V || - #k_map_pair{op=exact,val=V} <- Es], + #k_map{op=exact,es=Es} -> + Vals = [V || #k_map_pair{val=V} <- Es], Vals ++ As; _Other -> As @@ -1467,9 +1512,9 @@ arg_val(Arg, C) -> _ -> {set_kanno(S, []),U,T,Fs} end; - #k_map{es=Es} -> + #k_map{op=exact,es=Es} -> Keys = [begin - #k_map_pair{op=exact,key=#k_literal{val=Key}} = Pair, + #k_map_pair{key=#k_literal{val=Key}} = Pair, Key end || Pair <- Es], %% multiple keys may have the same name @@ -1885,7 +1930,7 @@ pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); pat_vars(#k_map{es=Es}) -> pat_list_vars(Es); -pat_vars(#k_map_pair{op=exact,val=V}) -> +pat_vars(#k_map_pair{val=V}) -> pat_vars(V). pat_list_vars(Ps) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index c7886a070d..ab66445f73 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,8 +38,8 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,es}). --record(k_map_pair, {anno=[],op,key,val}). +-record(k_map, {anno=[],var,op,es}). +-record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). -record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index edbd3f74f8..639c6737e2 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -110,15 +110,18 @@ format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) -> " | ",format_1(Var, Ctxt), $},$~ ]; -format_1(#k_map{es=Es}, Ctxt) -> - [$~,${, +format_1(#k_map{op=assoc,es=Es}, Ctxt) -> + ["~{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - $},$~ + "}~" + ]; +format_1(#k_map{op=exact,es=Es}, Ctxt) -> + ["::{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}::" ]; -format_1(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> - ["~<",format(K, Ctxt),",",format(V, Ctxt),">"]; -format_1(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> - ["::<",format(K, Ctxt),",",format(V, Ctxt),">"]; +format_1(#k_map_pair{key=K,val=V}, Ctxt) -> + ["<",format(K, Ctxt),",",format(V, Ctxt),">"]; format_1(#k_binary{segs=S}, Ctxt) -> ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"]; format_1(#k_bin_seg{next=Next}=S, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index ae928e955c..c4f54a7970 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -367,12 +367,10 @@ literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{var=Var,es=Es}, Ctxt) -> - {map,literal(Var, Ctxt),literal_list(Es, Ctxt)}; -literal(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> - {map_pair_assoc,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> - {map_pair_exact,literal(K, Ctxt),literal(V, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map_pair{key=K,val=V}, Ctxt) -> + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; literal(#k_literal{val=V}, _Ctxt) -> {literal,V}. @@ -402,8 +400,8 @@ literal2(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal2(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{es=Es}, Ctxt) -> - {map,literal_list2(Es, Ctxt)}; +literal2(#k_map{op=Op,es=Es}, Ctxt) -> + {map,Op,literal_list2(Es, Ctxt)}; literal2(#k_map_pair{key=K,val=V}, Ctxt) -> {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 0a637a07cd..39c9fea5d9 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -48,6 +48,7 @@ NO_OPT= \ fun \ guard \ lc \ + map \ match \ misc \ num_bif \ diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 9f15845d33..149b9bbb8f 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1]). + no_partition/1,calling_a_binary/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition]}]. + no_partition,calling_a_binary]}]. init_per_suite(Config) -> @@ -1178,6 +1178,17 @@ no_partition_2([], a5) -> no_partition_2(42.0, a6) -> six. +calling_a_binary(Config) when is_list(Config) -> + [] = call_binary(<<>>, []), + {'EXIT',{badarg,_}} = (catch call_binary(<<1>>, [])), + {'EXIT',{badarg,_}} = (catch call_binary(<<1,2,3>>, [])), + ok. + +call_binary(<<>>, Acc) -> + Acc; +call_binary(<<H,T/bits>>, Acc) -> + T(<<Acc/binary,H>>). + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 69f61a046f..8151dc1b16 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -22,7 +22,8 @@ init_per_group/2,end_per_group/2, t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1, eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1, - unused_multiple_values_error/1,unused_multiple_values/1]). + unused_multiple_values_error/1,unused_multiple_values/1, + multiple_aliases/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -38,7 +39,8 @@ groups() -> [{p,test_lib:parallel(), [t_element,setelement,t_length,append,t_apply,bifs, eq,nested_call_in_case,guard_try_catch,coverage, - unused_multiple_values_error,unused_multiple_values]}]. + unused_multiple_values_error,unused_multiple_values, + multiple_aliases]}]. init_per_suite(Config) -> @@ -299,8 +301,6 @@ cover_is_safe_bool_expr(X) -> bsm_an_inlined(<<_:8>>, _) -> ok; bsm_an_inlined(_, _) -> error. -id(I) -> I. - unused_multiple_values_error(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), Dir = filename:dirname(code:which(?MODULE)), @@ -338,3 +338,31 @@ do_something(I) -> put(unused_multiple_values, [I|get(unused_multiple_values)]), I. + + +%% Make sure that multiple aliases does not cause +%% the case expression to be evaluated twice. +multiple_aliases(Config) when is_list(Config) -> + do_ma(fun() -> + X = Y = run_once(), + {X,Y} + end, {ok,ok}), + do_ma(fun() -> + case {true,run_once()} of + {true=A=B,ok=X=Y} -> + {A,B,X,Y} + end + end, {true,true,ok,ok}), + ok. + +do_ma(Fun, Expected) when is_function(Fun, 0) -> + Expected = Fun(), + ran_once = erase(run_once), + ok. + +run_once() -> + undefined = put(run_once, ran_once), + ok. + + +id(I) -> I. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 0ba5d5dd0d..86f65c3ed6 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -38,10 +38,10 @@ %% not covered in 17.0-rc1 t_build_and_match_over_alloc/1, t_build_and_match_empty_val/1, - t_build_and_match_val/1 + t_build_and_match_val/1, %% errors in 17.0-rc1 - + t_update_values/1 ]). suite() -> []. @@ -62,10 +62,10 @@ all() -> [ %% not covered in 17.0-rc1 t_build_and_match_over_alloc, t_build_and_match_empty_val, - t_build_and_match_val + t_build_and_match_val, %% errors in 17.0-rc1 - + t_update_values ]. groups() -> []. @@ -179,6 +179,17 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + %% Test need to be in a fun. + %% This tests that let expr optimisation in sys_core_fold + %% covers maps correctly. + F = fun() -> + M0 = id(#{ "a" => [1,2,3] }), + #{ "a" := _ } = M0, + M0#{ "a" := b } + end, + + #{ "a" := b } = F(), + %% Error cases, FIXME: should be 'badmap'? {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), @@ -212,16 +223,46 @@ t_update_exact(Config) when is_list(Config) -> M2 = M0#{3.0:=new}, #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, M2 = M0#{3.0=>wrong,3.0:=new}, - M2 = M0#{3=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + ok. +t_update_values(Config) when is_list(Config) -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + [1337, {some_val, 1337}] = get_val(M1), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), ok. +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + t_guard_bifs(Config) when is_list(Config) -> true = map_guard_head(#{a=>1}), false = map_guard_head([]), diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 14a17fe304..1d36aae8ee 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -505,12 +505,12 @@ lambda(Fun, As) when is_function(Fun) -> %% ... and the fun was defined in interpreted code {module, ?MODULE} -> - {Mod,Name,Bs} = + {Mod,Name,Bs, Cs} = case erlang:fun_info(Fun, env) of - {env,[{{M,F},Bs0,Cs}]} -> - {M,F,Bs0}; - {env,[{{M,F},Bs0,Cs,FName}]} -> - {M,F,add_binding(FName, Fun, Bs0)} + {env,[{{M,F},Bs0,Cs0}]} -> + {M,F,Bs0, Cs0}; + {env,[{{M,F},Bs0,Cs0,FName}]} -> + {M,F,add_binding(FName, Fun, Bs0), Cs0} end, {arity, Arity} = erlang:fun_info(Fun, arity), if @@ -654,6 +654,21 @@ expr({tuple,Line,Es0}, Bs0, Ieval) -> {Vs,Bs} = eval_list(Es0, Bs0, Ieval#ieval{line=Line}), {value,list_to_tuple(Vs),Bs}; +%% Map +expr({map,Line,Fs0}, Bs0, Ieval) -> + {Fs,Bs} = eval_map_fields(Fs0, Bs0, Ieval#ieval{line=Line,top=false}), + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, + #{}, Fs), + {value,Value,Bs}; +expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line,top=false}, + {value,E,Bs1} = expr(E0, Bs0, Ieval), + {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval), + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); + ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, + E, Fs), + {value,Value,Bs2}; + %% A block of statements expr({block,Line,Es},Bs,Ieval) -> seq(Es, Bs, Ieval#ieval{line=Line}); @@ -1127,7 +1142,7 @@ eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> case catch match1(P, V, erl_eval:new_bindings(), Bs0) of {match,Bsn} -> Bs2 = add_bindings(Bsn, Bs0), - CompFun(Bs2) ++ eval_generate(Rest, P, Bs2, CompFun, Ieval); + CompFun(Bs2) ++ eval_generate(Rest, P, Bs0, CompFun, Ieval); nomatch -> eval_generate(Rest, P, Bs0, CompFun, Ieval) end; @@ -1468,6 +1483,19 @@ guard_expr({cons,_,H0,T0}, Bs) -> guard_expr({tuple,_,Es0}, Bs) -> {values,Es} = guard_exprs(Es0, Bs), {value,list_to_tuple(Es)}; +guard_expr({map,_,Fs0}, Bs) -> + Fs = eval_map_fields_guard(Fs0, Bs), + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, + #{}, Fs), + {value,Value}; +guard_expr({map,_,E0,Fs0}, Bs) -> + {value,E} = guard_expr(E0, Bs), + Fs = eval_map_fields_guard(Fs0, Bs), + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); + ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, + E, Fs), + io:format("~p~n", [{E,Value}]), + {value,Value}; guard_expr({bin,_,Flds}, Bs) -> {value,V,_Bs} = eval_bits:expr_grp(Flds, Bs, @@ -1477,6 +1505,37 @@ guard_expr({bin,_,Flds}, Bs) -> end, [], false), {value,V}. + +%% eval_map_fields([Field], Bindings, IEvalState) -> +%% {[{map_assoc | map_exact,Key,Value}],Bindings} + +eval_map_fields(Fs, Bs, Ieval) -> + eval_map_fields(Fs, Bs, Ieval, fun expr/3). + +eval_map_fields_guard(Fs0, Bs) -> + {Fs,_} = eval_map_fields(Fs0, Bs, #ieval{}, + fun (G0, Bs0, _) -> + {value,G} = guard_expr(G0, Bs0), + {value,G,Bs0} + end), + Fs. + +eval_map_fields(Fs, Bs, Ieval, F) -> + eval_map_fields(Fs, Bs, Ieval, F, []). + +eval_map_fields([{map_field_assoc,Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> + Ieval = Ieval0#ieval{line=Line}, + {value,K,Bs1} = F(K0, Bs0, Ieval), + {value,V,Bs2} = F(V0, Bs1, Ieval), + eval_map_fields(Fs, Bs2, Ieval0, F, [{map_assoc,K,V}|Acc]); +eval_map_fields([{map_field_exact,Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> + Ieval = Ieval0#ieval{line=Line}, + {value,K,Bs1} = F(K0, Bs0, Ieval), + {value,V,Bs2} = F(V0, Bs1, Ieval), + eval_map_fields(Fs, Bs2, Ieval0, F, [{map_exact,K,V}|Acc]); +eval_map_fields([], Bs, _Ieval, _F, Acc) -> + {lists:reverse(Acc),Bs}. + %% match(Pattern,Term,Bs) -> {match,Bs} | nomatch match(Pat, Term, Bs) -> try match1(Pat, Term, Bs, Bs) @@ -1506,6 +1565,8 @@ match1({cons,_,H,T}, [H1|T1], Bs0, BBs) -> match1({tuple,_,Elts}, Tuple, Bs, BBs) when length(Elts) =:= tuple_size(Tuple) -> match_tuple(Elts, Tuple, 1, Bs, BBs); +match1({map,_,Fields}, Map, Bs, BBs) when is_map(Map) -> + match_map(Fields, Map, Bs, BBs); match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) -> try eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), @@ -1529,6 +1590,17 @@ match_tuple([E|Es], Tuple, I, Bs0, BBs) -> match_tuple([], _, _, Bs, _BBs) -> {match,Bs}. +match_map([{map_field_exact,_,K0,Pat}|Fs], Map, Bs0, BBs) -> + {value,K,BBs} = expr(K0, BBs, #ieval{}), + case maps:find(K, Map) of + {ok,Value} -> + {match,Bs} = match1(Pat, Value, Bs0, BBs), + match_map(Fs, Map, Bs, BBs); + error -> throw(nomatch) + end; +match_map([], _, Bs, _BBs) -> + {match,Bs}. + head_match([Par|Pars], [Arg|Args], Bs0, BBs) -> try match1(Par, Arg, Bs0, BBs) of {match,Bs} -> head_match(Pars, Args, Bs, BBs) diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 9806692afc..266cf239dd 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -194,6 +194,11 @@ pattern({cons,Line,H0,T0}) -> pattern({tuple,Line,Ps0}) -> Ps1 = pattern_list(Ps0), {tuple,Line,Ps1}; +pattern({map,Line,Fs0}) -> + Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> + {map_field_exact,L,expr(K, false),pattern(V)} + end, Fs0), + {map,Line,Fs1}; pattern({op,_,'-',{integer,Line,I}}) -> {value,Line,-I}; pattern({op,_,'+',{integer,Line,I}}) -> @@ -262,6 +267,8 @@ guard_test({string,Line,_}) -> {value,Line,false}; guard_test({nil,Line}) -> {value,Line,false}; guard_test({cons,Line,_,_}) -> {value,Line,false}; guard_test({tuple,Line,_}) -> {value,Line,false}; +guard_test({map,Line,_}) -> {value,Line,false}; +guard_test({map,Line,_,_}) -> {value,Line,false}; guard_test({bin,Line,_}) -> {value,Line,false}. gexpr({var,Line,V}) -> {var,Line,V}; @@ -279,6 +286,13 @@ gexpr({cons,Line,H0,T0}) -> gexpr({tuple,Line,Es0}) -> Es1 = gexpr_list(Es0), {tuple,Line,Es1}; +gexpr({map,Line,Fs0}) -> + Fs1 = map_fields(Fs0, fun gexpr/1), + {map,Line,Fs1}; +gexpr({map,Line,E0,Fs0}) -> + E1 = gexpr(E0), + Fs1 = map_fields(Fs0, fun gexpr/1), + {map,Line,E1,Fs1}; gexpr({bin,Line,Flds0}) -> Flds = gexpr_list(Flds0), {bin,Line,Flds}; @@ -341,6 +355,13 @@ expr({cons,Line,H0,T0}, _Lc) -> expr({tuple,Line,Es0}, _Lc) -> Es1 = expr_list(Es0), {tuple,Line,Es1}; +expr({map,Line,Fs0}, _Lc) -> + Fs1 = map_fields(Fs0), + {map,Line,Fs1}; +expr({map,Line,E0,Fs0}, _Lc) -> + E1 = expr(E0, false), + Fs1 = map_fields(Fs0), + {map,Line,E1,Fs1}; expr({block,Line,Es0}, Lc) -> %% Unfold block into a sequence. Es1 = exprs(Es0, Lc), @@ -436,7 +457,7 @@ expr({lc,Line,E0,Gs0}, _Lc) -> %R8. ({b_generate,L,P0,Qs}) -> %R12. {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard(Expr) of + case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end @@ -448,7 +469,7 @@ expr({bc,Line,E0,Gs0}, _Lc) -> %R12. ({b_generate,L,P0,Qs}) -> %R12. {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard(Expr) of + case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end @@ -491,42 +512,6 @@ expr({bin_element,Line,Expr,Size,Type}, _Lc) -> expr(Other, _Lc) -> exit({?MODULE,{unknown_expr,Other}}). -%% is_guard(Expression) -> true | false. -%% Test if a general expression is a guard test or guard BIF. -%% Cannot use erl_lint here as sys_pre_expand has transformed source. - -is_guard({op,_,Op,L,R}) -> - erl_internal:comp_op(Op, 2) andalso is_gexpr_list([L,R]); -is_guard({call,_,{remote,_,{atom,_,erlang},{atom,_,Test}},As}) -> - Arity = length(As), - (erl_internal:guard_bif(Test, Arity) orelse - erl_internal:old_type_test(Test, Arity)) andalso is_gexpr_list(As); -is_guard({atom,_,true}) -> true; -is_guard(_) -> false. - -is_gexpr({var,_,_}) -> true; -is_gexpr({atom,_,_}) -> true; -is_gexpr({integer,_,_}) -> true; -is_gexpr({char,_,_}) -> true; -is_gexpr({float,_,_}) -> true; -is_gexpr({string,_,_}) -> true; -is_gexpr({nil,_}) -> true; -is_gexpr({cons,_,H,T}) -> is_gexpr_list([H,T]); -is_gexpr({tuple,_,Es}) -> is_gexpr_list(Es); -is_gexpr({call,_,{remote,_,{atom,_,erlang},{atom,_,F}},As}) -> - Ar = length(As), - case erl_internal:guard_bif(F, Ar) of - true -> is_gexpr_list(As); - false -> erl_internal:arith_op(F, Ar) andalso is_gexpr_list(As) - end; -is_gexpr({op,_,Op,A}) -> - erl_internal:arith_op(Op, 1) andalso is_gexpr(A); -is_gexpr({op,_,Op,A1,A2}) -> - erl_internal:arith_op(Op, 2) andalso is_gexpr_list([A1,A2]); -is_gexpr(_) -> false. - -is_gexpr_list(Es) -> lists:all(fun (E) -> is_gexpr(E) end, Es). - consify([A|As]) -> {cons,0,A,consify(As)}; consify([]) -> {value,0,[]}. @@ -550,6 +535,15 @@ fun_clauses([{clause,L,H,G,B}|Cs]) -> [{clause,L,head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; fun_clauses([]) -> []. +map_fields(Fs) -> + map_fields(Fs, fun (E) -> expr(E, false) end). + +map_fields([{map_field_assoc,L,N,V}|Fs], F) -> + [{map_field_assoc,L,F(N),F(V)}|map_fields(Fs)]; +map_fields([{map_field_exact,L,N,V}|Fs], F) -> + [{map_field_exact,L,F(N),F(V)}|map_fields(Fs)]; +map_fields([], _) -> []. + %% new_var_name() -> VarName. new_var_name() -> diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index bdd671cff1..2755db64b8 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -630,14 +630,13 @@ find_beam(Mod, Src) -> File = filename:join(SrcDir, BeamFile), case is_file(File) of true -> File; - false -> find_beam_1(Mod, BeamFile, SrcDir) + false -> find_beam_1(BeamFile, SrcDir) end. -find_beam_1(Mod, BeamFile, SrcDir) -> +find_beam_1(BeamFile, SrcDir) -> RootDir = filename:dirname(SrcDir), EbinDir = filename:join(RootDir, "ebin"), CodePath = [EbinDir | code:get_path()], - BeamFile = atom_to_list(Mod) ++ code:objfile_extension(), lists:foldl(fun(_, Beam) when is_list(Beam) -> Beam; (Dir, error) -> File = filename:join(Dir, BeamFile), diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 5aa290c61b..9a0ce14ecd 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -44,6 +44,7 @@ MODULES= \ fun_SUITE \ lc_SUITE \ line_number_SUITE \ + map_SUITE \ record_SUITE \ trycatch_SUITE \ test_lib \ diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index be9312b68f..ba60ed6fb3 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -64,6 +64,7 @@ config(priv_dir,_) -> % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> + test_lib:interpret(?MODULE), ?line Dog = ?t:timetrap(?default_timeout), [{watchdog, Dog} | Config]. end_per_testcase(_Case, Config) -> diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl new file mode 100644 index 0000000000..e9f4ea1fad --- /dev/null +++ b/lib/debugger/test/map_SUITE.erl @@ -0,0 +1,1002 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(map_SUITE). + +%% Copied from map_SUITE in erts. + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, + t_update_literals/1,t_match_and_update_literals/1, + t_update_map_expressions/1, + t_update_assoc/1,t_update_exact/1, + t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, + t_guard_receive/1, t_guard_fun/1, + t_list_comprehension/1, + t_map_sort_literals/1, + %t_size/1, + t_map_size/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_pdict/1, + t_ets/1, + t_dets/1 + ]). + +-include_lib("stdlib/include/ms_transform.hrl"). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, + t_update_literals, t_match_and_update_literals, + t_update_map_expressions, + t_update_assoc,t_update_exact, + t_guard_bifs, t_guard_sequence, t_guard_update, + t_guard_receive,t_guard_fun, t_list_comprehension, + t_map_sort_literals, + + %% Specific Map BIFs + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_map_size, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_pdict, + t_ets + ]. + +groups() -> []. + +init_per_suite(Config) -> + test_lib:interpret(?MODULE), + Config. + +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% error case + %V = 32, + %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = id(#{<<"hi",V,"all">> => 1}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + ok. + + +%% Tests size(Map). +%% not implemented, perhaps it shouldn't be either + +%t_size(Config) when is_list(Config) -> +% 0 = size(#{}), +% 1 = size(#{a=>1}), +% 1 = size(#{a=>#{a=>1}}), +% 2 = size(#{a=>1, b=>2}), +% 3 = size(#{a=>1, b=>2, b=>"3"}), +% ok. + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch map_size([])), + {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{badarg,_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +% test map updates without matching +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + #{ a := 1 } = M#{a => 1}, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Error cases, FIXME: should be 'badmap'? + {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + + +t_update_assoc(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + %% M2 = M0#{3=>wrong,3.0:=new}, %% FIXME + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + ok. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), + ok. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = #{ a => 1 } < id(#{ b => 1}), + false = #{ b => 1 } < id(#{ a => 1}), + true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}), + true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), + false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), + false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + false = #{ 1.0 => 1 } < id(#{ 1 => 1}), + + %% value order + true = #{ a => 1 } < id(#{ a => 2}), + false = #{ a => 2 } < id(#{ a => 1}), + false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), + true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + + true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + + ok. + +%% BIFs +t_bif_map_get(Config) when is_list(Config) -> + + 1 = maps:get(a, #{ a=> 1}), + 2 = maps:get(b, #{ a=> 1, b => 2}), + "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), + "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }), + + %% error case + {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])), + {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})), + {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})), + ok. + +t_bif_map_find(Config) when is_list(Config) -> + + {ok, 1} = maps:find(a, #{ a=> 1}), + {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), + {ok, "int"} = maps:find(1, #{ 1 => "int"}), + {ok, "float"} = maps:find(1.0, #{ 1.0=> "float"}), + + {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), + {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + {ok, "v4"} = maps:find(<<"k2">>, M#{ <<"k2">> => "v4" }), + + %% error case + error = maps:find(a,#{}), + error = maps:find(a,#{b=>1, c=>2}), + error = maps:find(1.0, #{ 1 => "int"}), + error = maps:find(1, #{ 1.0 => "float"}), + error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key + + + {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))), + {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))), + ok. + + +t_bif_map_is_key(Config) when is_list(Config) -> + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + + true = maps:is_key("hi", M1), + true = maps:is_key(int, M1), + true = maps:is_key(<<"key">>, M1), + true = maps:is_key(4, M1), + + false = maps:is_key(5, M1), + false = maps:is_key(<<"key2">>, M1), + false = maps:is_key("h", M1), + false = maps:is_key("hello", M1), + false = maps:is_key(atom, M1), + false = maps:is_key(any, id(#{})), + + false = maps:is_key("hi", maps:remove("hi", M1)), + true = maps:is_key("hi", M1), + true = maps:is_key(1, maps:put(1, "number", M1)), + false = maps:is_key(1.0, maps:put(1, "number", M1)), + + %% error case + {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))), + {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))), + ok. + +t_bif_map_keys(Config) when is_list(Config) -> + [] = maps:keys(#{}), + + [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), + [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + [4,int,"hi",<<"key">>] = maps:keys(M1), + + %% error case + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])), + {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), + ok. + +t_bif_map_new(Config) when is_list(Config) -> + #{} = maps:new(), + 0 = erlang:map_size(maps:new()), + ok. + +t_bif_map_merge(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:merge(#{},#{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(#{}, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(M0, #{}), + + M1 = #{ "hi" => "hello again", float => 3.3, {1,2} => "tuple", 4 => integer }, + + #{4 := number, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello", <<"key">> := <<"value">>} = maps:merge(M1,M0), + + #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), + + %% error case + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)), + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), + {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), + + ok. + + +t_bif_map_put(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), + + ["hi"] = maps:keys(M1), + ["hello"] = maps:values(M1), + + M2 = #{ int := 3 } = maps:put(int, 3, M1), + + [int,"hi"] = maps:keys(M2), + [3,"hello"] = maps:values(M2), + + M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), + + [int,"hi",<<"key">>] = maps:keys(M3), + [3,"hello",<<"value">>] = maps:values(M3), + + M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), + + [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), + [wat,3,"hello",<<"value">>] = maps:values(M4), + + M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), + + [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), + [number,wat,3,"hello",<<"value">>] = maps:values(M5), + + M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), + + [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), + [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + + %% error case + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), + {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), + ok. + +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), + [number,wat,3,<<"value">>] = maps:values(M1), + + M2 = maps:remove(int, M1), + [4,18446744073709551629,<<"key">>] = maps:keys(M2), + [number,wat,<<"value">>] = maps:values(M2), + + M3 = maps:remove(<<"key">>, M2), + [4,18446744073709551629] = maps:keys(M3), + [number,wat] = maps:values(M3), + + M4 = maps:remove(18446744073709551629, M3), + [4] = maps:keys(M4), + [number] = maps:values(M4), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), + ok. + +t_bif_map_update(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello again", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update("hi", "hello again", M0), + + #{ "hi" := "hello", int := 1337, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(int, 1337, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"new value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(<<"key">>, <<"new value">>, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := integer, 18446744073709551629 := wat} = maps:update(4, integer, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), + + %% error case + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})), + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)), + {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)), + + ok. + + + +t_bif_map_values(Config) when is_list(Config) -> + + [] = maps:values(#{}), + + [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), + [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, + [number,3,"hello2",<<"value2">>] = maps:values(M2), + [number,3,"hello",<<"value">>] = maps:values(M1), + + %% error case + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])), + {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), + ok. + +t_erlang_hash(Config) when is_list(Config) -> + + ok = t_bif_erlang_phash2(), + ok = t_bif_erlang_phash(), + ok = t_bif_erlang_hash(), + + ok. + +t_bif_erlang_phash2() -> + + 39679005 = erlang:phash2(#{}), + 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), + 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), + 14363616 = erlang:phash2(#{ 1 => a }), + 51612236 = erlang:phash2(#{ a => 1 }), + + 37468437 = erlang:phash2(#{{} => <<>>}), + 44049159 = erlang:phash2(#{<<>> => {}}), + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 118679416 = erlang:phash2(M0), + 51612236 = erlang:phash2(M1), + 118679416 = erlang:phash2(M2), + ok. + +t_bif_erlang_phash() -> + Sz = 1 bsl 32, + 268440612 = erlang:phash(#{},Sz), + 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), + 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), + 1394238263 = erlang:phash(#{ 1 => a },Sz), + 4066388227 = erlang:phash(#{ a => 1 },Sz), + + 1578050717 = erlang:phash(#{{} => <<>>},Sz), + 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 3590546636 = erlang:phash(M0,Sz), + 4066388227 = erlang:phash(M1,Sz), + 3590546636 = erlang:phash(M2,Sz), + ok. + +t_bif_erlang_hash() -> + Sz = 1 bsl 27 - 1, + 5158 = erlang:hash(#{},Sz), + 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), + 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), + 126071654 = erlang:hash(#{ 1 => a },Sz), + 126426236 = erlang:hash(#{ a => 1 },Sz), + + 101655720 = erlang:hash(#{{} => <<>>},Sz), + 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 38260486 = erlang:hash(M0,Sz), + 126426236 = erlang:hash(M1,Sz), + 38260486 = erlang:hash(M2,Sz), + ok. + + +t_map_encode_decode(Config) when is_list(Config) -> + <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), + Pairs = [ + {a,b},{"key","values"},{<<"key">>,<<"value">>}, + {1,b},{[atom,1],{<<"wat">>,1,2,3}}, + {aa,"values"}, + {1 bsl 64 + (1 bsl 50 - 1), sc1}, + {99, sc2}, + {1 bsl 65 + (1 bsl 51 - 1), sc3}, + {88, sc4}, + {1 bsl 66 + (1 bsl 52 - 1), sc5}, + {77, sc6}, + {1 bsl 67 + (1 bsl 53 - 1), sc3}, + {75, sc6}, {-10,sc8}, + {<<>>, sc9}, {3.14158, sc10}, + {[3.14158], sc11}, {more_atoms, sc12}, + {{more_tuples}, sc13}, {self(), sc14}, + {{},{}},{[],[]} + ], + ok = map_encode_decode_and_match(Pairs,[],#{}), + + %% check sorting + + %% literally #{ b=>2, a=>1 } in the internal order + #{ a:=1, b:=2 } = + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,100,0,1,97,97,2,97,1>>), + + + %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order + #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, + 107,0,2,104,105, % "hi" :: list() + 100,0,1,97, % a :: atom() + 100,0,1,98, % b :: atom() + 107,0,5,118,97,108,117,101, % "value" :: list() + 97,33, % 33 :: integer() + 97,55 % 55 :: integer() + >>), + + + %% error cases + %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> + %% which is: #{ a=>1, b=>1 } + + %% uniqueness violation + %% literally #{ a=>1, "hi"=>"value", a=>2 } + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,3,100,0,1,97,107,0,2,104,105,100,0,1,97,97,1,107,0,5,118,97,108,117,101,97,2>>)), + + %% bad size (too large) + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,100,0,1,98,97,1,97,1>>)), + + %% bad size (too small) .. should fail just truncate it .. weird. + %% possibly change external format so truncated will be #{a:=1} + #{ a:=b } = + erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + ok. + +map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> + M1 = maps:put(K,V,M0), + B0 = erlang:term_to_binary(M1), + Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), + %% sort Ks and Vs according to term spec, then match it + ok = match_encoded_map(B0, length(Ls), [Kbin||{_,Kbin,_}<-Ls] ++ [Vbin||{_,_,Vbin}<-Ls]), + %% decode and match it + M1 = erlang:binary_to_term(B0), + map_encode_decode_and_match(Pairs,Ls,M1); +map_encode_decode_and_match([],_,_) -> ok. + +match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> + match_encoded_map(Encoded,Items); +match_encoded_map(_,_,_) -> no_match_size. + +match_encoded_map(<<>>,[]) -> ok; +match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> + Size = erlang:byte_size(Item), + <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, + EncodedTerm = Item, %% Asssert + match_encoded_map(Bin1,Items). + + +t_bif_map_to_list(Config) when is_list(Config) -> + [] = maps:to_list(#{}), + [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}), + [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), + [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), + [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ + <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{ + <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}), + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), + {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))), + ok. + + +t_bif_map_from_list(Config) when is_list(Config) -> + #{} = maps:from_list([]), + A = maps:from_list([]), + 0 = erlang:map_size(A), + + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), + #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), + + #{a:=2} = maps:from_list([{a,1},{a,3},{a,2}]), + + #{ <<"hi">>:=v1,3:=v3,"hi":=v6,hi:=v4,{hi,3}:=v5} = + maps:from_list([{3,v3},{"hi",v6},{hi,v4},{{hi,3},v5},{<<"hi">>,v1}]), + + #{<<"hi">>:=v6,3:=v8,"hi":=v11,hi:=v9,{hi,3}:=v10} = + maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, + {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},b]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},{b,b,3}]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},<<>>]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b}|{b,a}]))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id(a))), + {'EXIT', {badarg,_}} = (catch maps:from_list(id(42))), + ok. + +%% Maps module, not BIFs +t_maps_fold(_Config) -> + Vs = lists:seq(1,100), + M = maps:from_list([{{k,I},{v,I}}||I<-Vs]), + + %% fold + 5050 = maps:fold(fun({k,_},{v,V},A) -> V + A end, 0, M), + + ok. + +t_maps_map(_Config) -> + Vs = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I<-Vs]), + M2 = maps:from_list([{I,{token,I}}||I<-Vs]), + + M2 = maps:map(fun(_K,V) -> {token,V} end, M1), + ok. + +t_maps_size(_Config) -> + Vs = lists:seq(1,100), + lists:foldl(fun(I,M) -> + M1 = maps:put(I,I,M), + I = maps:size(M1), + M1 + end, #{}, Vs), + ok. + + +t_maps_without(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + + +%% MISC +t_pdict(_Config) -> + + put(#{ a => b, b => a},#{ c => d}), + put(get(#{ a => b, b => a}),1), + 1 = get(#{ c => d}), + #{ c := d } = get(#{ a => b, b => a}). + +t_ets(_Config) -> + + Tid = ets:new(map_table,[]), + + [ets:insert(Tid,{maps:from_list([{I,-I}]),I}) || I <- lists:seq(1,100)], + + + [{#{ 2 := -2},2}] = ets:lookup(Tid,#{ 2 => -2 }), + + %% Test equal + [3,4] = lists:sort( + ets:select(Tid,[{{'$1','$2'}, + [{'or',{'==','$1',#{ 3 => -3 }}, + {'==','$1',#{ 4 => -4 }}}], + ['$2']}])), + %% Test match + [30,50] = lists:sort( + ets:select(Tid, + [{{#{ 30 => -30}, '$1'},[],['$1']}, + {{#{ 50 => -50}, '$1'},[],['$1']}] + )), + + ets:insert(Tid,{#{ a => b, b => c, c => a},transitivity}), + + %% Test equal with map of different size + [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), + + %% Test match with map of different size + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + + %%% Test match with don't care value + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + + %% Test is_map bif + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{not_a_map,2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{{nope,a,tuple},2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + + %% Test map_size bif + [3] = ets:select(Tid,[{{'$1','_'},[{'==',{map_size,'$1'},3}], + [{map_size,'$1'}]}]), + + true = ets:delete(Tid,#{50 => -50}), + [] = ets:lookup(Tid,#{50 => -50}), + + ets:delete(Tid), + ok. + +t_dets(_Config) -> + ok. + +getmsg(_Tracer) -> + receive V -> V after 100 -> timeout end. + +trace_collector(Msg,Parent) -> + io:format("~p~n",[Msg]), + Parent ! Msg, + Parent. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 9222a28a77..0d048b607e 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. 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 @@ -29,17 +29,19 @@ dialyzer_cl_parse, dialyzer_codeserver, dialyzer_contracts, + dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, dialyzer_explanation, - dialyzer_gui, dialyzer_gui_wx, dialyzer_options, dialyzer_plt, dialyzer_races, dialyzer_succ_typings, dialyzer_typesig, - dialyzer_utils]}, + dialyzer_utils, + dialyzer_timing, + dialyzer_worker]}, {registered, []}, {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, {env, []}]}. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 33fa107019..03f9684b02 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2302,6 +2302,9 @@ bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> signal_guard_fail(Eval, Guard, ArgTypes, State) -> signal_guard_failure(Eval, Guard, ArgTypes, fail, State). +-spec signal_guard_fatal_fail(eval(), cerl:c_call(), [erl_types:erl_type()], + state()) -> no_return(). + signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) -> signal_guard_failure(Eval, Guard, ArgTypes, fatal_fail, State). diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index b4b3d5a092..70e14781f7 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2535,8 +2535,10 @@ enter_type(Key, Val, Map) when is_integer(Key) -> erase_type(Key, Map); false -> LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT), - [?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) || - not is_equal(LimitedVal, Val)], + case is_equal(LimitedVal, Val) of + true -> ok; + false -> ?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) + end, case dict:find(Key, Map) of {ok, Value} -> case is_equal(Value, LimitedVal) of diff --git a/lib/dialyzer/test/Makefile b/lib/dialyzer/test/Makefile index 27cabc8ef8..f43e04dd59 100644 --- a/lib/dialyzer/test/Makefile +++ b/lib/dialyzer/test/Makefile @@ -11,6 +11,7 @@ AUXILIARY_FILES=\ dialyzer_test_constants.hrl\ dialyzer_common.erl\ file_utils.erl\ + dialyzer_SUITE.erl\ plt_SUITE.erl # ---------------------------------------------------- diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl new file mode 100644 index 0000000000..63214c915d --- /dev/null +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -0,0 +1,73 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. 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(dialyzer_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +%% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). +-define(application, dialyzer). + +%% Test server specific exports +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). +-export([init_per_testcase/2, end_per_testcase/2]). + +%% Test cases must be exported. +-export([app_test/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [app_test]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. +end_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +%%% +%%% Test cases starts here. +%%% + +app_test(doc) -> + ["Test that the .app file does not contain any `basic' errors"]; +app_test(suite) -> + []; +app_test(Config) when is_list(Config) -> + ?line ?t:app_test(dialyzer). diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 7b8d2940c1..b3ec9fd33d 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1751,7 +1751,7 @@ using async threads potentially makes your system volnerable to slow client attacks. If set to true and no async threads are available, the sendfile call will return <c>{error,einval}</c>. - Introduced in 17.0. Default is false.</item> + Introduced in Erlang/OTP 17.0. Default is false.</item> </taglist> </p> </desc> diff --git a/lib/mnesia/test/mnesia_frag_test.erl b/lib/mnesia/test/mnesia_frag_test.erl index d3f6762af7..6695fbc880 100644 --- a/lib/mnesia/test/mnesia_frag_test.erl +++ b/lib/mnesia/test/mnesia_frag_test.erl @@ -461,7 +461,7 @@ nice_iter_access(Tab, FragNames, RawRead) -> ExpectedLast = lists:last(Keys), ?match(ExpectedLast, mnesia:last(Tab)), - ExpectedAllPrev = ['$end_of_table' | lists:reverse(tl(lists:reverse(Keys)))], + ExpectedAllPrev = ['$end_of_table' | lists:droplast(Keys)], ?match(ExpectedAllPrev, lists:map(fun(K) -> mnesia:prev(Tab, K) end, Keys)), ExpectedAllNext = tl(Keys) ++ ['$end_of_table'], @@ -477,7 +477,7 @@ evil_iter_access(Tab, FragNames, RawRead) -> ExpectedLast = lists:last(Keys), ?match(ExpectedLast, mnesia:last(Tab)), - ExpectedAllPrev = ['$end_of_table' | lists:reverse(tl(lists:reverse(Keys)))], + ExpectedAllPrev = ['$end_of_table' | lists:droplast(Keys)], ?match(ExpectedAllPrev, lists:map(fun(K) -> mnesia:prev(Tab, K) end, Keys)), ExpectedAllNext = tl(Keys) ++ ['$end_of_table'], diff --git a/lib/orber/src/orber_interceptors.erl b/lib/orber/src/orber_interceptors.erl index 407823ea79..62870b35b5 100644 --- a/lib/orber/src/orber_interceptors.erl +++ b/lib/orber/src/orber_interceptors.erl @@ -112,7 +112,7 @@ pop_system_message_interceptor(out) -> [{_, []}] -> ok; [{_, Interceptors}] -> - ets:insert(orber_interceptors, {message_out_interceptors, remove_last_element(Interceptors)}); + ets:insert(orber_interceptors, {message_out_interceptors, lists:droplast(Interceptors)}); _ -> corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) end. @@ -151,12 +151,3 @@ apply_message_interceptors([], F, ObjRef, Bytes) -> apply_message_interceptors([M | Rest], F, ObjRef, Bytes) -> apply_message_interceptors(Rest, F, ObjRef, apply(M, F, [ObjRef, Bytes])). - -remove_last_element([]) -> - []; -remove_last_element([M]) -> - []; -remove_last_element([M |Tail]) -> - remove_last_element([Tail]). - - diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index 8afc841fa6..c6394115e3 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -76,7 +76,6 @@ point }). - -define(unspecified, 0). -define(keyCompromise, 1). -define(cACompromise, 2). @@ -88,23 +87,4 @@ -define(privilegeWithdrawn, 9). -define(aACompromise, 10). --type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key(). --type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key(). --type rsa_public_key() :: #'RSAPublicKey'{}. --type rsa_private_key() :: #'RSAPrivateKey'{}. --type dsa_private_key() :: #'DSAPrivateKey'{}. --type dsa_public_key() :: {integer(), #'Dss-Parms'{}}. --type ec_public_key() :: {#'ECPoint'{},{namedCurve, Oid::tuple()} | #'ECParameters'{}}. --type ec_private_key() :: #'ECPrivateKey'{}. --type der_encoded() :: binary(). --type decrypt_der() :: binary(). --type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' - | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' - | 'SubjectPublicKeyInfo' | 'CertificationRequest' | 'CertificateList'. --type pem_entry() :: {pki_asn1_type(), binary(), %% DER or Encrypted DER - not_encrypted | {Cipher :: string(), Salt :: binary()}}. --type asn1_type() :: atom(). %% see "OTP-PUB-KEY.hrl --type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | - auth_keys. - -endif. % -ifdef(public_key). diff --git a/lib/public_key/src/pubkey_cert_records.erl b/lib/public_key/src/pubkey_cert_records.erl index f7a361d5a8..9a8e49f265 100644 --- a/lib/public_key/src/pubkey_cert_records.erl +++ b/lib/public_key/src/pubkey_cert_records.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -99,7 +99,7 @@ transform(Other,_) -> Other. %%-------------------------------------------------------------------- --spec supportedPublicKeyAlgorithms(Oid::tuple()) -> asn1_type(). +-spec supportedPublicKeyAlgorithms(Oid::tuple()) -> public_key:asn1_type(). %% %% Description: Returns the public key type for an algorithm %% identifier tuple as found in SubjectPublicKeyInfo. diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index c0a0de815b..3a1653d989 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -51,7 +51,7 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec decode(binary()) -> [pem_entry()]. +-spec decode(binary()) -> [public_key:pem_entry()]. %% %% Description: Decodes a PEM binary. %%-------------------------------------------------------------------- @@ -59,7 +59,7 @@ decode(Bin) -> decode_pem_entries(split_bin(Bin), []). %%-------------------------------------------------------------------- --spec encode([pem_entry()]) -> iolist(). +-spec encode([public_key:pem_entry()]) -> iolist(). %% %% Description: Encodes a list of PEM entries. %%-------------------------------------------------------------------- @@ -67,7 +67,7 @@ encode(PemEntries) -> encode_pem_entries(PemEntries). %%-------------------------------------------------------------------- --spec decipher({pki_asn1_type(), DerEncrypted::binary(), +-spec decipher({public_key:pki_asn1_type(), DerEncrypted::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}}, string()) -> Der::binary(). %% diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 41280b9e14..0522ea6ac3 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. 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 @@ -35,7 +35,8 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}]. +-spec decode(binary(), public_key | public_key:ssh_file()) -> + [{public_key:public_key(), Attributes::list()}]. %% %% Description: Decodes a ssh file-binary. %%-------------------------------------------------------------------- @@ -52,7 +53,7 @@ decode(Bin, Type) -> openssh_decode(Bin, Type). %%-------------------------------------------------------------------- --spec encode([{public_key(), Attributes::list()}], ssh_file()) -> +-spec encode([{public_key:public_key(), Attributes::list()}], public_key:ssh_file()) -> binary(). %% %% Description: Encodes a list of ssh file entries. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index ceecbcc7f2..a732455aa7 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -49,6 +49,27 @@ pkix_crls_validate/3 ]). +-export_type([public_key/0, private_key/0, pem_entry/0, + pki_asn1_type/0, asn1_type/0, ssh_file/0, der_encoded/0]). + +-type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key(). +-type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key(). + +-type rsa_public_key() :: #'RSAPublicKey'{}. +-type rsa_private_key() :: #'RSAPrivateKey'{}. +-type dsa_private_key() :: #'DSAPrivateKey'{}. +-type dsa_public_key() :: {integer(), #'Dss-Parms'{}}. +-type ec_public_key() :: {#'ECPoint'{},{namedCurve, Oid::tuple()} | #'ECParameters'{}}. +-type ec_private_key() :: #'ECPrivateKey'{}. +-type der_encoded() :: binary(). +-type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' + | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' + | 'SubjectPublicKeyInfo' | 'CertificationRequest' | 'CertificateList'. +-type pem_entry() :: {pki_asn1_type(), binary(), %% DER or Encrypted DER + not_encrypted | {Cipher :: string(), Salt :: binary()}}. +-type asn1_type() :: atom(). %% see "OTP-PUB-KEY.hrl +-type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | + auth_keys. -type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. -type public_crypt_options() :: [{rsa_pad, rsa_padding()}]. diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 21cdedc156..5692138a8a 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -65,7 +65,7 @@ is_auth_key(Key, User,Opts) -> %% Used by client is_host_key(Key, PeerName, Algorithm, Opts) -> - case lookup_host_key(PeerName, Algorithm, Opts) of + case lookup_host_key(Key, PeerName, Algorithm, Opts) of {ok, Key} -> true; _ -> @@ -121,9 +121,9 @@ decode_ssh_file(Pem, Password) -> %% return {ok, Key(s)} or {error, not_found} %% -lookup_host_key(Host, Alg, Opts) -> +lookup_host_key(KeyToMatch, Host, Alg, Opts) -> Host1 = replace_localhost(Host), - do_lookup_host_key(Host1, Alg, Opts). + do_lookup_host_key(KeyToMatch, Host1, Alg, Opts). add_host_key(Host, Key, Opts) -> @@ -204,10 +204,10 @@ replace_localhost("localhost") -> replace_localhost(Host) -> Host. -do_lookup_host_key(Host, Alg, Opts) -> +do_lookup_host_key(KeyToMatch, Host, Alg, Opts) -> case file:open(file_name(user, "known_hosts", Opts), [read, binary]) of {ok, Fd} -> - Res = lookup_host_key_fd(Fd, Host, Alg), + Res = lookup_host_key_fd(Fd, KeyToMatch, Host, Alg), file:close(Fd), {ok, Res}; {error, enoent} -> {error, not_found}; @@ -228,16 +228,16 @@ identity_pass_phrase('ssh-rsa') -> identity_pass_phrase("ssh-rsa") -> rsa_pass_phrase. -lookup_host_key_fd(Fd, Host, KeyType) -> +lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) -> case io:get_line(Fd, '') of eof -> {error, not_found}; Line -> case ssh_decode_line(Line, known_hosts) of [{Key, Attributes}] -> - handle_host(Fd, Host, proplists:get_value(hostnames, Attributes), Key, KeyType); + handle_host(Fd, KeyToMatch, Host, proplists:get_value(hostnames, Attributes), Key, KeyType); [] -> - lookup_host_key_fd(Fd, Host, KeyType) + lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) end end. @@ -248,13 +248,13 @@ ssh_decode_line(Line, Type) -> [] end. -handle_host(Fd, Host, HostList, Key, KeyType) -> +handle_host(Fd, KeyToMatch, Host, HostList, Key, KeyType) -> Host1 = host_name(Host), - case lists:member(Host1, HostList) and key_match(Key, KeyType) of - true -> + case lists:member(Host1, HostList) andalso key_match(Key, KeyType) of + true when KeyToMatch == Key -> Key; - false -> - lookup_host_key_fd(Fd, Host, KeyType) + _ -> + lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) end. host_name(Atom) when is_atom(Atom) -> diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 01a0988718..fa4397b2f5 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -315,8 +315,8 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_DATA), ?UINT32(Recipient), ?UINT32(Len), Data:Le recipient_channel = Recipient, data = Data }; -decode(<<?BYTE(?SSH_MSG_CHANNEL_EXTENDED_DATA), ?UINT32(Recipient), - ?UINT32(DataType), Data/binary>>) -> +decode(<<?BYTE(?SSH_MSG_CHANNEL_EXTENDED_DATA), ?UINT32(Recipient), + ?UINT32(DataType), ?UINT32(Len), Data:Len/binary>>) -> #ssh_msg_channel_extended_data{ recipient_channel = Recipient, data_type_code = DataType, diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 213b5c714d..52665635f0 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -673,7 +673,7 @@ resolve_symlinks_2(["." | RestPath], State0, LinkCnt, AccPath) -> resolve_symlinks_2([".." | RestPath], State0, LinkCnt, AccPath) -> %% Remove the last path component AccPathComps0 = filename:split(AccPath), - Path = case lists:reverse(tl(lists:reverse(AccPathComps0))) of + Path = case lists:droplast(AccPathComps0) of [] -> ""; AccPathComps -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 8c2b84bc1e..7edc6554ca 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -712,7 +712,7 @@ validate_option(certfile, undefined = Value) -> validate_option(certfile, Value) when is_binary(Value) -> Value; validate_option(certfile, Value) when is_list(Value) -> - list_to_binary(Value); + binary_filename(Value); validate_option(key, undefined) -> undefined; @@ -729,7 +729,7 @@ validate_option(keyfile, undefined) -> validate_option(keyfile, Value) when is_binary(Value) -> Value; validate_option(keyfile, Value) when is_list(Value), Value =/= "" -> - list_to_binary(Value); + binary_filename(Value); validate_option(password, Value) when is_list(Value) -> Value; @@ -743,7 +743,7 @@ validate_option(cacertfile, undefined) -> validate_option(cacertfile, Value) when is_binary(Value) -> Value; validate_option(cacertfile, Value) when is_list(Value), Value =/= ""-> - list_to_binary(Value); + binary_filename(Value); validate_option(dh, Value) when Value == undefined; is_binary(Value) -> Value; @@ -752,12 +752,12 @@ validate_option(dhfile, undefined = Value) -> validate_option(dhfile, Value) when is_binary(Value) -> Value; validate_option(dhfile, Value) when is_list(Value), Value =/= "" -> - list_to_binary(Value); + binary_filename(Value); validate_option(psk_identity, undefined) -> undefined; validate_option(psk_identity, Identity) when is_list(Identity), Identity =/= "", length(Identity) =< 65535 -> - list_to_binary(Identity); + binary_filename(Identity); validate_option(user_lookup_fun, undefined) -> undefined; validate_option(user_lookup_fun, {Fun, _} = Value) when is_function(Fun, 3) -> @@ -766,7 +766,8 @@ validate_option(srp_identity, undefined) -> undefined; validate_option(srp_identity, {Username, Password}) when is_list(Username), is_list(Password), Username =/= "", length(Username) =< 255 -> - {list_to_binary(Username), list_to_binary(Password)}; + {unicode:characters_to_binary(Username), + unicode:characters_to_binary(Password)}; validate_option(ciphers, Value) when is_list(Value) -> Version = tls_record:highest_protocol_version([]), @@ -1036,3 +1037,7 @@ connection_sup(tls_connection) -> tls_connection_sup; connection_sup(dtls_connection) -> dtls_connection_sup. + +binary_filename(FileName) -> + Enc = file:native_name_encoding(), + unicode:characters_to_binary(FileName, unicode, Enc). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 102215119d..64b89e9f95 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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 @@ -82,13 +82,13 @@ validate_extensions_fun, depth :: integer(), certfile :: binary(), - cert :: der_encoded(), + cert :: public_key:der_encoded(), keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', der_encoded()}, + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()}, password :: string(), - cacerts :: [der_encoded()], + cacerts :: [public_key:der_encoded()], cacertfile :: binary(), - dh :: der_encoded(), + dh :: public_key:der_encoded(), dhfile :: binary(), user_lookup_fun, % server option, fun to lookup the user psk_identity :: binary(), diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 251a383cf8..ee3c51c62c 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -123,6 +123,14 @@ </desc> </func> <func> + <name name="droplast" arity="1"/> + <fsummary>Drop the last element of a list</fsummary> + <desc> + <p>Drops the last element of a <c><anno>List</anno></c>. The list should + be non-empty, otherwise the function will crash with a <c>function_clause</c></p> + </desc> + </func> + <func> <name name="dropwhile" arity="2"/> <fsummary>Drop elements from a list while a predicate is true</fsummary> <desc> diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index ee7dd128f1..75505d7d84 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1999</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -41,10 +41,10 @@ future.</p> <p>The functionality described in EEP10 was implemented in Erlang/OTP - as of R13A, but that was by no means the end of it. In R14B01 support + R13A, but that was by no means the end of it. In Erlang/OTP R14B01 support for Unicode file names was added, although it was in no way complete and was by default disabled on platforms where no guarantee was given - for the file name encoding. With R16A came support for UTF-8 encoded + for the file name encoding. With Erlang/OTP R16A came support for UTF-8 encoded source code, among with enhancements to many of the applications to support both Unicode encoded file names as well as support for UTF-8 encoded files in several circumstances. Most notable is the support @@ -52,8 +52,8 @@ for UTF-8 and more support for Unicode character sets in the I/O-system.</p> - <p>In 17.0, the encoding default for Erlang source files was - switched to UTF-8 and in 18.0 Erlang will support atoms in the full + <p>In Erlang/OTP 17.0, the encoding default for Erlang source files was + switched to UTF-8 and in Erlang/OTP 18.0 Erlang will support atoms in the full Unicode range, meaning full Unicode function and module names</p> @@ -222,7 +222,7 @@ <tag>Representation</tag> <item>To handle Unicode characters in Erlang, we have to have a common representation both in lists and binaries. The EEP (10) and - the subsequent initial implementation in R13A settled a standard + the subsequent initial implementation in Erlang/OTP R13A settled a standard representation of Unicode characters in Erlang.</item> <tag>Manipulation</tag> <item>The Unicode characters need to be processed by the Erlang @@ -274,9 +274,9 @@ (<c>+fnu</c>) on platforms where this is not the default.</item> <tag>Source code encoding</tag> <item>When it comes to the Erlang source code, there is support - for the UTF-8 encoding and bytewise encoding. The default in R16B - is bytewise (or latin1) encoding. You can control the encoding by - a comment like: + for the UTF-8 encoding and bytewise encoding. The default in + Erlang/OTP R16B was bytewise (or latin1) encoding; in Erlang/OTP 17.0 + it was changed to UTF-8. You can control the encoding by a comment like: <code> %% -*- coding: utf-8 -*- </code> @@ -290,7 +290,7 @@ <item>Having the source code in UTF-8 also allows you to write string literals containing Unicode characters with code points > 255, although atoms, module names and function names will be - restricted to the ISO-Latin-1 range until the 18.0 release. Binary + restricted to the ISO-Latin-1 range until the Erlang/OTP 18.0 release. Binary literals where you use the <c>/utf8</c> type, can also be expressed using Unicode characters > 255. Having module names using characters other than 7-bit ASCII can cause trouble on @@ -304,7 +304,7 @@ <section> <title>Standard Unicode Representation</title> <p>In Erlang, strings are actually lists of integers. A string was - up until R13 defined to be encoded in the ISO-latin-1 (ISO8859-1) + up until Erlang/OTP R13 defined to be encoded in the ISO-latin-1 (ISO8859-1) character set, which is, code point by code point, a sub-range of the Unicode character set.</p> <p>The standard list encoding for strings was therefore easily @@ -321,7 +321,7 @@ encoding has to be decided upon and the string should be converted to a binary in the preferred encoding using <c>unicode:characters_to_binary/{1,2,3}</c>. Strings are not - generally lists of bytes, as they were before R13. They are lists of + generally lists of bytes, as they were before Erlang/OTP R13. They are lists of characters. Characters are not generally bytes, they are Unicode code points.</p> @@ -447,8 +447,8 @@ Bin4 = <<"Hello"/utf16>>,</code> probably will not appreciate). Another way is to keep it backwards compatible so that only the ISO-Latin-1 character set is used to detect a string. A third way would be to let the user decide - exactly what Unicode ranges are to be viewed as characters. In - R16B you can select either the whole Unicode range or the + exactly what Unicode ranges are to be viewed as characters. Since + Erlang/OTP R16B you can select either the whole Unicode range or the ISO-Latin-1 range by supplying the startup flag <c>+pc </c><i>Range</i>, where <i>Range</i> is either <c>latin1</c> or <c>unicode</c>. For backwards compatibility, the default is @@ -685,7 +685,7 @@ Eshell V5.10.1 (abort with ^G) </item> </taglist> - <p>The Unicode file naming support was introduced with OTP release + <p>The Unicode file naming support was introduced with Erlang/OTP R14B01. A VM operating in Unicode file name translation mode can work with files having names in any language or character set (as long as it is supported by the underlying OS and file system). The @@ -709,7 +709,7 @@ Eshell V5.10.1 (abort with ^G) problem even if it uses transparent file naming. Very few systems have mixed file name encodings. A consistent UTF-8 named system will work perfectly in Unicode file name mode. It was still however - considered experimental in R14B01 and is still not the default on + considered experimental in Erlang/OTP R14B01 and is still not the default on such systems. Unicode file name translation is turned on with the <c>+fnu</c> switch to the On Linux, a VM started without explicitly stating the file name translation mode will default to <c>latin1</c> @@ -757,7 +757,7 @@ Eshell V5.10.1 (abort with ^G) <title>Notes About Raw File Names</title> <marker id="notes-about-raw-filenames"/> <p>Raw file names were introduced together with Unicode file name - support in erts-5.8.2 (OTP R14B01). The reason "raw file + support in erts-5.8.2 (Erlang/OTP R14B01). The reason "raw file names" was introduced in the system was to be able to consistently represent file names given in different encodings on the same system. Having the VM automatically translate a file name @@ -798,10 +798,10 @@ Eshell V5.10.1 (abort with ^G) the argument as a binary.</p> <p>To force Unicode file name translation mode on systems where this - is not the default was considered experimental in OTP R14B01 due to + is not the default was considered experimental in Erlang/OTP R14B01 due to the fact that the initial implementation did not ignore wrongly encoded file names, so that raw file names could spread unexpectedly - throughout the system. Beginning with R16B, the wrongly encoded file + throughout the system. Beginning with Erlang/OTP R16B, the wrongly encoded file names are only retrieved by special functions (e.g. <c>file:list_dir_all/1</c>), so the impact on existing code is much lower, why it is now supported. Unicode file name translation @@ -1032,7 +1032,7 @@ ok <c>io</c>/<c>io_lib:format</c> with the <c>"~tp"</c> and <c>~tP</c> formatting instructions, as described above.</p> <p>You can check this option by calling io:printable_range/0, - which in R16B will return <c>unicode</c> or <c>latin1</c>. To be + which will return <c>unicode</c> or <c>latin1</c>. To be compatible with future (expected) extensions to the settings, one should rather use <c>io_lib:printable_list/1</c> to check if a list is printable according to the setting. That function will @@ -1070,8 +1070,8 @@ ok <item> <p>This function returns the default encoding for Erlang source files (if no encoding comment is present) in the currently - running release. For R16 this returns <c>latin1</c> (meaning - bytewise encoding). In 17.0 and forward it returns + running release. In Erlang/OTP R16B <c>latin1</c> was returned (meaning + bytewise encoding). In Erlang/OTP 17.0 and forward it returns <c>utf8</c>.</p> <p>The encoding of each file can be specified using comments as described in diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index d6a9f4645d..6303465d3d 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -22,7 +22,7 @@ -compile({no_auto_import,[min/2]}). -export([append/2, append/1, subtract/2, reverse/1, - nth/2, nthtail/2, prefix/2, suffix/2, last/1, + nth/2, nthtail/2, prefix/2, suffix/2, droplast/1, last/1, seq/2, seq/3, sum/1, duplicate/2, min/1, max/1, sublist/2, sublist/3, delete/2, unzip/1, unzip3/1, zip/2, zip3/3, zipwith/3, zipwith3/4, @@ -203,6 +203,19 @@ suffix(Suffix, List) -> Delta = length(List) - length(Suffix), Delta >= 0 andalso nthtail(Delta, List) =:= Suffix. +%% droplast(List) returns the list dropping its last element + +-spec droplast(List) -> InitList when + List :: [T, ...], + InitList :: [T], + T :: term(). + +%% This is the simple recursive implementation +%% reverse(tl(reverse(L))) is faster on average, +%% but creates more garbage. +droplast([_T]) -> []; +droplast([H|T]) -> [H|droplast(T)]. + %% last(List) returns the last element in a list. -spec last(List) -> Last when diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 92253ef5b9..f4589a8e24 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -61,7 +61,7 @@ zip_unzip/1, zip_unzip3/1, zipwith/1, zipwith3/1, filter_partition/1, otp_5939/1, otp_6023/1, otp_6606/1, otp_7230/1, - suffix/1, subtract/1]). + suffix/1, subtract/1, droplast/1]). %% Sort randomized lists until stopped. %% @@ -2641,4 +2641,12 @@ sub_non_matching(A, B) -> sub(A, B) -> Res = A -- B, Res = lists:subtract(A, B). - + +%% Test lists:droplast/1 +droplast(Config) when is_list(Config) -> + ?line [] = lists:droplast([x]), + ?line [x] = lists:droplast([x, y]), + ?line {'EXIT', {function_clause, _}} = (catch lists:droplast([])), + ?line {'EXIT', {function_clause, _}} = (catch lists:droplast(x)), + + ok. diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 4d6e88f58b..877675772f 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -637,6 +637,14 @@ lay_2(Node, Ctxt) -> sep([follow(text("fun"), D, Ctxt1#ctxt.sub_indent), text("end")]); + named_fun_expr -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:named_fun_expr_name(Node), Ctxt1), + D = lay_clauses(erl_syntax:named_fun_expr_clauses(Node), + {function,D1}, Ctxt1), + sep([follow(text("fun"), D, Ctxt1#ctxt.sub_indent), + text("end")]); + module_qualifier -> {PrecL, _Prec, PrecR} = inop_prec(':'), D1 = lay(erl_syntax:module_qualifier_argument(Node), diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 6aeb251ac2..d26b8adfcd 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1800,16 +1800,19 @@ munge_expr({match,Line,ExprL,ExprR}, Vars) -> munge_expr({tuple,Line,Exprs}, Vars) -> {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), {{tuple,Line,MungedExprs}, Vars2}; -munge_expr({record,Line,Expr,Exprs}, Vars) -> +munge_expr({record,Line,Name,Exprs}, Vars) -> %% Only for Vsn=raw_abstract_v1 - {MungedExprName, Vars2} = munge_expr(Expr, Vars), + {MungedExprFields, Vars2} = munge_exprs(Exprs, Vars, []), + {{record,Line,Name,MungedExprFields}, Vars2}; +munge_expr({record,Line,Arg,Name,Exprs}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedArg, Vars2} = munge_expr(Arg, Vars), {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), - {{record,Line,MungedExprName,MungedExprFields}, Vars3}; + {{record,Line,MungedArg,Name,MungedExprFields}, Vars3}; munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> %% Only for Vsn=raw_abstract_v1 - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; + {MungedExprR, Vars2} = munge_expr(ExprR, Vars), + {{record_field,Line,ExprL,MungedExprR}, Vars2}; munge_expr({cons,Line,ExprH,ExprT}, Vars) -> {MungedExprH, Vars2} = munge_expr(ExprH, Vars), {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl index 3ca8cd7d14..0f28b3dd5e 100644 --- a/lib/wx/api_gen/wx_gen.erl +++ b/lib/wx/api_gen/wx_gen.erl @@ -25,7 +25,7 @@ -include_lib("xmerl/include/xmerl.hrl"). --import(lists, [foldl/3,foldr/3,reverse/1, keysearch/3, map/2, filter/2]). +-import(lists, [foldl/3,foldr/3,reverse/1,keysearch/3,map/2,filter/2,droplast/1]). -import(proplists, [get_value/2,get_value/3]). -compile(export_all). @@ -69,7 +69,7 @@ gen_code() -> gen_xml() -> %% {ok, Defs} = file:consult("wxapi.conf"), -%% Rel = reverse(tl(reverse(os:cmd("wx-config --release")))), +%% Rel = droplast(os:cmd("wx-config --release")), %% Dir = " /usr/include/wx-" ++ Rel ++ "/wx/", %% Files0 = [Dir ++ File || {class, File, _, _, _} <- Defs], %% Files1 = [Dir ++ File || {doxygen, File} <- Defs], @@ -172,7 +172,7 @@ parse_defs([], Acc) -> reverse(Acc). meta_info(C=#class{name=CName,methods=Ms0}) -> Ms = lists:append(Ms0), HaveConstructor = lists:keymember(constructor, #method.method_type, Ms), - case lists:keysearch(destructor, #method.method_type, Ms) of + case keysearch(destructor, #method.method_type, Ms) of false when HaveConstructor -> Dest = #method{name = "destroy", id = next_id(func_id), method_type = destructor, params = [this(CName)]}, @@ -288,7 +288,7 @@ parse_attr1([{{attr,_}, #xmlElement{content=C, attributes=Attrs}}|R], AttrList0, parse_attr1([{_Id,_}|R],AttrList,Info, Res) -> parse_attr1(R,AttrList,Info, Res); parse_attr1([],Left,_, Res) -> - {lists:reverse(Res), Left}. + {reverse(Res), Left}. attr_acc(#param{name=N}, List) -> Name = list_to_atom(N), @@ -994,7 +994,7 @@ erl_skip_opt2([F={_,{N,In,_},M=#method{where=Where}}|Ms],Acc1,Acc2,Check) -> [] -> erl_skip_opt2(Ms,[F|Acc1],[M#method{where=erl_no_opt}|Acc2],[]); _ -> - Skipped = reverse(tl(reverse(In))), + Skipped = droplast(In), T = fun({_,{_,Args,_},_}) -> true =:= types_differ(Skipped,Args) end, case lists:all(T, Check) of true -> |