diff options
Diffstat (limited to 'lib')
31 files changed, 812 insertions, 400 deletions
diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index 25debf09d4..acce4eca14 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -215,23 +215,18 @@ all_cases(Suite,Config) -> fun({group,G}) -> {value,{G,Props,GTCs}} = lists:keysearch(G,1,Suite:groups()), - GTCs1 = case lists:member(parallel,Props) of - true -> - %%! TEMPORARY WORKAROUND FOR PROBLEM - %%! WITH ct_test_support NOT HANDLING - %%! VERIFICATION OF PARALLEL GROUPS - %%! CORRECTLY! - []; - false -> - [[{?eh,tc_start,{Suite,GTC}}, - {?eh,tc_done,{Suite,GTC,ok}}] || - GTC <- GTCs] - end, - [{?eh,tc_start,{Suite,{init_per_group,G,Props}}}, - {?eh,tc_done,{Suite,{init_per_group,G,Props},ok}} | - GTCs1] ++ - [{?eh,tc_start,{Suite,{end_per_group,G,Props}}}, - {?eh,tc_done,{Suite,{end_per_group,G,Props},ok}}]; + GTCs1 = [[{?eh,tc_start,{Suite,GTC}}, + {?eh,tc_done,{Suite,GTC,ok}}] || + GTC <- GTCs], + GEvs = [{?eh,tc_start,{Suite,{init_per_group,G,Props}}}, + {?eh,tc_done,{Suite,{init_per_group,G,Props},ok}} | + GTCs1] ++ + [{?eh,tc_start,{Suite,{end_per_group,G,Props}}}, + {?eh,tc_done,{Suite,{end_per_group,G,Props},ok}}], + case lists:member(parallel, Props) of + true -> [{parallel,GEvs}]; + false -> GEvs + end; (TC) -> [{?eh,tc_done,{Suite,TC,ok}}] end, GroupsAndTCs), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index ec5deb6905..3435a46ca9 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -101,6 +101,8 @@ -record(ireceive2, {anno=#a{},clauses,timeout,action}). -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). +-record(ifilter, {anno=#a{},arg}). +-record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -117,10 +119,13 @@ -type ireceive2() :: #ireceive2{}. -type iset() :: #iset{}. -type itry() :: #itry{}. +-type ifilter() :: #ifilter{}. +-type igen() :: #igen{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry(). + | iprotect() | ireceive1() | ireceive2() | iset() | itry() + | ifilter() | igen(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -479,8 +484,9 @@ expr({cons,L,H0,T0}, St0) -> {T1,Tps,St2} = safe(T0, St1), A = lineno_anno(L, St2), {ann_c_cons(A, H1, T1),Hps ++ Tps,St2}; -expr({lc,L,E,Qs}, St) -> - lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St); +expr({lc,L,E,Qs0}, St0) -> + {Qs1,St1} = preprocess_quals(L, Qs0, St0), + lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> bc_tq(L, E, Qs, {nil,L}, St); expr({tuple,L,Es0}, St0) -> @@ -647,7 +653,7 @@ expr({match,L,P0,E0}, St0) -> Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; -expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> +expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. %% %% To avoid achieving quadratic complexity if there is a chain of @@ -655,7 +661,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% evaluation of More now. Evaluating More here could also reduce the %% number variables in the environment for letrec. {Mc,Mps,St1} = safe(More, St0), - {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1), + {Qs,St2} = preprocess_quals(Llc, Qs0, St1), + {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,L,'andalso',E1,E2}, St0) -> {#c_var{name=V0},St} = new_var(L, St0), @@ -889,136 +896,45 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. -lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lc", St0), - {Head,St2} = new_var(St1), - {Tname,St3} = new_var_name(St2), - LA = lineno_anno(Line, St3), - CGAnno = #a{anno=[list_comprehension|LA]}, - LAnno = #a{anno=LA}, - Tail = #c_var{anno=LA,name=Tname}, - {Arg,St4} = new_var(St3), - {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4), - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Pc,St8} = list_gen_pattern(P, Line, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - - %% Avoid constructing a default clause if the list comprehension - %% only has a variable as generator and there are no guard - %% tests. In other words, if the comprehension is equivalent to - %% lists:map/2. - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail)], - guard=[], - body=[Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA, Pc, Tail)], - guard=Guardc, - body=Lps ++ [Lc]}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St9}; -lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("blc", St0), LA = lineno_anno(Line, St1), LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - HeadBinPattern = pattern(P, St1), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St2} = append_tail_segment(Ps0, St1), - {EPs,St3} = emasculate_segments(Ps, St2), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St4} = new_var(St3), - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - Tname = Tail#c_var.name, - {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5), - {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Gc,Gps,St10} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - {TailSegList,_,St} = append_tail_segment([], St10), - Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[Pattern], - guard=Guardc, - body=Bps ++ [Bc]}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern], - guard=[], - body=[#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Tail]}]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[], - body=[Mc]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St}; -lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0), - {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=CGAnno, - args=[], - clauses=[#iclause{anno=LAnno,pats=[], - guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[Mc]}}, - [],St2}; - false -> - {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St3} = novars(Fil0, St2), - {#icase{anno=CGAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Lps ++ [Lc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[Mc]}], - fc=Fc}, - Fps,St3} - end; + F = #c_var{anno=LA,name={Name,1}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, + {Var,St2} = new_var(St1), + Fc = function_clause([Var], LA, {Name,1}), + TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2), + {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard, + body=Lps ++ [Lc]}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]}, + [],St4}; +lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); lc_tq(Line, E0, [], Mc0, St0) -> {H1,Hps,St1} = safe(E0, St0), {T1,Tps,St} = force_safe(Mc0, St1), @@ -1028,146 +944,60 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. %% This TQ from Gustafsson ERLANG'05. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qualifiers, _, St0) -> +bc_tq(Line, Exp, Qs0, _, St0) -> {BinVar,St1} = new_var(St0), - {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1), - {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2), + {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), + {Qs,St3} = preprocess_quals(Line, Qs0, St2), + {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3), Pre = SzPre ++ [#iset{var=BinVar, arg=#iprimop{name=#c_literal{val=bs_init_writable}, args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("lbc", St0), - LA = lineno_anno(Line, St1), - {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - {Arg,St3} = new_var(St2), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat! - {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4), - {Nc,Nps,St6} = expr(NewMore, St5), - {Pc,St7} = list_gen_pattern(P, Line, St6), - {Gc,Gps,St8} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail),AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc], - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA,Pc,Tail),AccVar], - guard=Guardc, - body=Body}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St8}; -bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lbc", St0), LA = lineno_anno(Line, St1), - {AccVar,St2} = new_var(LA, St1), LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - HeadBinPattern = pattern(P, St2), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St3} = append_tail_segment(Ps0, St2), - {EPs,St4} = emasculate_segments(Ps, St3), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St5} = new_var(St4), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6), - {Nc,Nps,St8} = expr(NewMore, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc], - {TailSegList,_,St} = append_tail_segment([], St9), - Cs = [#iclause{anno=LAnno, - pats=[Pattern,AccVar], - guard=Guardc, - body=Body}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern,AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList},AccVar], - guard=[], - body=[AccVar]}], - Fun = #ifun{anno=CGAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St}; -bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0), - {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=CGAnno, - args=[], - clauses=[#iclause{anno=LAnno, - pats=[], - guard=Gs,body=Bps ++ [Bc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[AccVar]}}, - [],St}; - false -> - {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St} = novars(Fil0, St2), - {#icase{anno=CGAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Bps ++ [Bc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[AccVar]}], - fc=Fc}, - Fps,St} - end; + {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1), + F = #c_var{anno=LA,name={Name,2}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, + Fc = function_clause(Vars, LA, {Name,2}), + TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], + body=[AccVar]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat,AccVar],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2), + Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc], + {[#iclause{anno=LAnno, + pats=[AccPat,AccVar],guard=AccGuard, + body=Body}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, + [],St4}; +bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> {E,Pre,St} = expr({bin,Bl,[{bin_element,Bl, {var,Bl,AccVar#c_var.name}, @@ -1175,16 +1005,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> [binary,{unit,1}]}|Elements]}, St0), #a{anno=A} = Anno0 = get_anno(E), Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, - %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. +%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) -> +%% {Case,[PreExpr],State}. +%% Transform an intermediate comprehension filter to its intermediate case +%% representation. + +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}}, + Mc, St0, Qs, TqFun) -> + %% The filter is an expression, it is compiled to a case of degree 1 with + %% 3 clauses, one accumulating, one skipping and the final one throwing + %% {case_clause,Value} where Value is the result of the filter and is not a + %% boolean. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {FailPat,St2} = new_var(St1), + Fc = fail_clause([FailPat], LA, + c_tuple([#c_literal{val=case_clause},FailPat])), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg], + clauses=[#iclause{anno=LAnno, + pats=[#c_literal{val=true}],guard=[], + body=Lps ++ [Lc]}, + #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[#c_literal{val=false}],guard=[], + body=[Mc]}], + fc=Fc}, + Pre,St2}; +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard}, + Mc, St0, Qs, TqFun) when is_list(Guard) -> + %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses, + %% the first matches if the guard succeeds and the comprehension continues + %% or the second one is selected and the current element is skipped. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[], + clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}], + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[Mc]}}, + [],St1}. + +%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}. +%% Preprocess a list of Erlang qualifiers into its intermediate representation, +%% represented as a list of #igen{} and #ifilter{} records. We recognise guard +%% tests and try to fold them together and join to a preceding generators, this +%% should give us better and more compact code. + +preprocess_quals(Line, Qs, St) -> + preprocess_quals(Line, Qs, St, []). + +preprocess_quals(Line, [Q|Qs0], St0, Acc) -> + case is_generator(Q) of + true -> + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Gen,St} = generator(Line, Q, Gs, St0), + preprocess_quals(Line, Qs, St, [Gen|Acc]); + false -> + LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + case is_guard_test(Q) of + true -> + %% When a filter is a guard test, its argument in the + %% #ifilter{} record is a list as returned by + %% lc_guard_tests/2. + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Cg,St} = lc_guard_tests([Q|Gs], St0), + Filter = #ifilter{anno=LAnno,arg=Cg}, + preprocess_quals(Line, Qs, St, [Filter|Acc]); + false -> + %% Otherwise, it is a pair {Pre,Arg} as in a generator + %% input. + {Ce,Pre,St} = novars(Q, St0), + Filter = #ifilter{anno=LAnno,arg={Pre,Ce}}, + preprocess_quals(Line, Qs0, St, [Filter|Acc]) + end + end; +preprocess_quals(_, [], St, Acc) -> + {reverse(Acc),St}. + +is_generator({generate,_,_,_}) -> true; +is_generator({b_generate,_,_,_}) -> true; +is_generator(_) -> false. + +%% +%% Generators are abstracted as sextuplets: +%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. +%% - acc_guard is the list of guards immediately following the current +%% generator in the qualifier list input. +%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for +%% <<X,1:X>> <= Expr. +%% - tail is the variable used in AccPat and SkipPat bound to the rest of the +%% generator input. +%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list +%% and bit string generators. +%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be +%% inserted before the comprehension function and Arg is the expression +%% that it should be passed. +%% + +%% generator(Line, Generator, Guard, State) -> {Generator',State}. +%% Transform a given generator into its #igen{} representation. + +generator(Line, {generate,Lg,P0,E}, Gs, St0) -> + LA = lineno_anno(Line, St0), + GA = lineno_anno(Lg, St0), + {Head,St1} = list_gen_pattern(P0, Line, St0), + {[Tail,Skip],St2} = new_vars(2, St1), + {Cg,St3} = lc_guard_tests(Gs, St2), + {AccPat,SkipPat} = case Head of + #c_var{} -> + %% If the generator pattern is a variable, the + %% pattern from the accumulator clause can be + %% reused in the skip one. lc_tq and bc_tq1 takes + %% care of dismissing the latter in that case. + Cons = ann_c_cons(LA, Head, Tail), + {Cons,Cons}; + nomatch -> + %% If it never matches, there is no need for + %% an accumulator clause. + {nomatch,ann_c_cons(LA, Skip, Tail)}; + _ -> + {ann_c_cons(LA, Head, Tail), + ann_c_cons(LA, Skip, Tail)} + end, + {Ce,Pre,St4} = safe(E, St3), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, + {Gen,St4}; +generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> + LA = lineno_anno(Line, St0), + GA = lineno_anno(Lg, St0), + Cp = #c_binary{segments=Segs} = pattern(P, St0), + %% The function append_tail_segment/2 keeps variable patterns as-is, making + %% it possible to have the same skip clause removal as with list generators. + {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0), + AccPat = Cp#c_binary{segments=AccSegs}, + {Cg,St2} = lc_guard_tests(Gs, St1), + {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + SkipPat = Cp#c_binary{segments=SkipSegs}, + {Ce,Pre,St4} = safe(E, St3), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St4}. + append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, unit=#c_literal{val=1}, type=#c_literal{val=binary}, flags=#c_literal{val=[unsigned,big]}}, - {Segs++[Tail],Var,St}. + {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1195,7 +1163,7 @@ emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> - {lists:reverse(Acc),St}. + {reverse(Acc),St}. lc_guard_tests([], St) -> {[],St}; lc_guard_tests(Gs0, St0) -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 925ad0c091..2e1a21178f 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-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 @@ -444,6 +444,15 @@ static ERL_NIF_TERM atom_ppbasis; static ERL_NIF_TERM atom_onbasis; #endif +static ErlNifResourceType* hmac_context_rtype; +struct hmac_context +{ + ErlNifMutex* mtx; + int alive; + HMAC_CTX ctx; +}; +static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -498,6 +507,15 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) return 0; } + hmac_context_rtype = enif_open_resource_type(env, NULL, "hmac_context", + (ErlNifResourceDtor*) hmac_context_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!hmac_context_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); + return 0; + } + if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. @@ -1280,11 +1298,19 @@ static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM #endif } +static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) +{ + if (obj->alive) { + HMAC_CTX_cleanup(&obj->ctx); + obj->alive = 0; + } + enif_mutex_destroy(obj->mtx); +} + static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Key) */ ErlNifBinary key; - ERL_NIF_TERM ret; - unsigned char * ctx_buf; + struct hmac_context* obj; const EVP_MD *md; if (argv[0] == atom_sha) md = EVP_sha1(); @@ -1309,57 +1335,60 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_badarg(env); } - ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret); - HMAC_CTX_init((HMAC_CTX *) ctx_buf); - HMAC_Init((HMAC_CTX *) ctx_buf, key.data, key.size, md); + obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); + obj->mtx = enif_mutex_create("crypto.hmac"); + obj->alive = 1; + HMAC_CTX_init(&obj->ctx); + HMAC_Init(&obj->ctx, key.data, key.size, md); - return ret; + return enif_make_resource(env, obj); } static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - ErlNifBinary context, data; - ERL_NIF_TERM ret; - unsigned char * ctx_buf; + ErlNifBinary data; + struct hmac_context* obj; - if (!enif_inspect_binary(env, argv[0], &context) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || context.size != sizeof(HMAC_CTX)) { + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) + || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); + } + enif_mutex_lock(obj->mtx); + if (!obj->alive) { + enif_mutex_unlock(obj->mtx); return enif_make_badarg(env); } + HMAC_Update(&obj->ctx, data.data, data.size); + enif_mutex_unlock(obj->mtx); - ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret); - memcpy(ctx_buf, context.data, context.size); - HMAC_Update((HMAC_CTX *)ctx_buf, data.data, data.size); CONSUME_REDS(env,data); - - return ret; + return argv[0]; } static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) or (Context, HashLen) */ - ErlNifBinary context; ERL_NIF_TERM ret; - HMAC_CTX ctx; + struct hmac_context* obj; unsigned char mac_buf[EVP_MAX_MD_SIZE]; unsigned char * mac_bin; unsigned int req_len = 0; unsigned int mac_len; - if (!enif_inspect_binary(env, argv[0], &context)) { - return enif_make_badarg(env); - } - if (argc == 2 && !enif_get_uint(env, argv[1], &req_len)) { + if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) + || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { return enif_make_badarg(env); } - if (context.size != sizeof(ctx)) { - return enif_make_badarg(env); + enif_mutex_lock(obj->mtx); + if (!obj->alive) { + enif_mutex_unlock(obj->mtx); + return enif_make_badarg(env); } - memcpy(&ctx, context.data, context.size); - HMAC_Final(&ctx, mac_buf, &mac_len); - HMAC_CTX_cleanup(&ctx); + HMAC_Final(&obj->ctx, mac_buf, &mac_len); + HMAC_CTX_cleanup(&obj->ctx); + obj->alive = 0; + enif_mutex_unlock(obj->mtx); if (argc == 2 && req_len < mac_len) { /* Only truncate to req_len bytes if asked. */ diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 81106b4cc2..a08dcec463 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * 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 @@ -17,6 +17,7 @@ * %CopyrightEnd% */ +#include <stdio.h> #include <string.h> #include <openssl/opensslconf.h> @@ -51,13 +52,28 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks); static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ +static void nomem(size_t size, const char* op) +{ + fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n", + op, size); + abort(); +} + static void* crypto_alloc(size_t size) { - return enif_alloc(size); + void *ret = enif_alloc(size); + + if (!ret && size) + nomem(size, "allocate"); + return ret; } static void* crypto_realloc(void* ptr, size_t size) { - return enif_realloc(ptr, size); + void* ret = enif_realloc(ptr, size); + + if (!ret && size) + nomem(size, "reallocate"); + return ret; } static void crypto_free(void* ptr) { diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 40f829e704..c95827c371 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -366,7 +366,11 @@ or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and <seealso marker="#hmac_final_n-2">hmac_final_n</seealso> </p> - + <warning><p>Do not use a <c>Context</c> as argument in more than one + call to hmac_update or hmac_final. The semantics of reusing old contexts + in any way is undefined and could even crash the VM in earlier releases. + The reason for this limitation is a lack of support in the underlying + OpenSSL API.</p></warning> </desc> </func> diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 2a631c3010..a92b890a80 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -229,7 +229,7 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> - <tag><c><![CDATA[-Wno_behaviours]]></c>***</tag> + <tag><c><![CDATA[-Wno_behaviours]]></c></tag> <item>Suppress warnings about behaviour callbacks which drift from the published recommended interfaces.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 03f9684b02..b00e0465e0 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -58,10 +58,12 @@ t_fun_range/2, t_integer/0, t_integers/1, t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_any_atom/3, t_is_boolean/2, - t_is_integer/2, t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, + t_is_integer/2, t_is_list/1, + t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, t_is_number/2, t_is_reference/2, t_is_pid/2, t_is_port/2, t_is_unit/1, - t_limit/2, t_list/0, t_maybe_improper_list/0, t_module/0, + t_limit/2, t_list/0, t_list_elements/2, + t_maybe_improper_list/0, t_module/0, t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/2, t_pid/0, t_port/0, t_product/1, t_reference/0, t_to_string/2, t_to_tlist/1, @@ -293,6 +295,7 @@ traverse(Tree, Map, State) -> t_is_any(ArgType) orelse t_is_simple(ArgType, State) orelse is_call_to_send(Arg) + orelse is_lc_simple_list(Arg, ArgType, State) of true -> % do not warn in these cases State1; @@ -2713,6 +2716,13 @@ is_call_to_send(Tree) -> andalso (Arity =:= 2) end. +is_lc_simple_list(Tree, TreeType, State) -> + Opaques = State#state.opaques, + Ann = cerl:get_ann(Tree), + lists:member(list_comprehension, Ann) + andalso t_is_list(TreeType) + andalso t_is_simple(t_list_elements(TreeType, Opaques), State). + filter_match_fail([Clause] = Cls) -> Body = cerl:clause_body(Clause), case cerl:type(Body) of diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options b/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..49ac917f61 --- /dev/null +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, [{warnings, [unmatched_returns]}]}. diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings b/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings new file mode 100644 index 0000000000..2784f2119e --- /dev/null +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings @@ -0,0 +1,5 @@ + +lc_warnings.erl:32: Expression produces a value of type [opaque_atom_adt:opaque_atom()], but this value is unmatched +lc_warnings.erl:43: Expression produces a value of type [array()], but this value is unmatched +lc_warnings.erl:65: Expression produces a value of type [lc_warnings:opaque_tuple()], but this value is unmatched +lc_warnings.erl:7: Expression produces a value of type ['ok' | {'error',atom()}], but this value is unmatched diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/lc_warnings.erl b/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/lc_warnings.erl new file mode 100644 index 0000000000..cb01a8fde3 --- /dev/null +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/lc_warnings.erl @@ -0,0 +1,95 @@ +-module(lc_warnings). +-compile([export_all]). + +close(Fs) -> + %% There should be a warning since we ignore a potential + %% {error,Error} return from file:close/1. + [file:close(F) || F <- Fs], + + %% No warning because the type of unmatched return will be ['ok'] + %% (which is a list of a simple type). + [ok = file:close(F) || F <- Fs], + + %% Suppressed. + _ = [file:close(F) || F <- Fs], + ok. + +format(X) -> + %% No warning since the result of the list comprehension is + %% a list of simple. + [io:format("~p\n", [E]) || E <- X], + + %% Warning explicitly suppressed. + _ = [io:format("~p\n", [E]) || E <- X], + ok. + +opaque1() -> + List = gen_atom(), + %% This is a list of an externally defined opaque type. Since + %% we are not allowed to peek inside opaque types, there should + %% be a warning (even though the type in this case happens to be + %% an atom). + [E || E <- List], + + %% Suppressed. + _ = [E || E <- List], + ok. + +opaque2() -> + List = gen_array(), + %% This is an list of an externally defined opaque type. Since + %% we are not allowed to peek inside opaque types, there should + %% be a warning. + [E || E <- List], + + %% Suppressed. + _ = [E || E <- List], + ok. + +opaque3() -> + List = gen_int(), + + %% No warning, since we are allowed to look into the type and can + %% see that it is a simple type. + [E || E <- List], + + %% Suppressed. + _ = [E || E <- List], + ok. + +opaque4() -> + List = gen_tuple(), + + %% There should be a warning, since we are allowed to look inside + %% the opaque type and see that it is a tuple (non-simple). + [E || E <- List], + + %% Suppressed. + _ = [E || E <- List], + ok. + +gen_atom() -> + [opaque_atom_adt:atom(ok)]. + +gen_array() -> + [array:new()]. + + +gen_int() -> + [opaque_int(42)]. + +gen_tuple() -> + [opaque_tuple(x, 25)]. + +-opaque opaque_int() :: integer(). + +-spec opaque_int(integer()) -> opaque_int(). + +opaque_int(Int) -> Int. + +-opaque opaque_tuple() :: {any(),any()}. + +-spec opaque_tuple(any(), any()) -> opaque_tuple(). + +opaque_tuple(X, Y) -> + {X,Y}. diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/opaque_atom_adt.erl b/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/opaque_atom_adt.erl new file mode 100644 index 0000000000..b5b51fe75b --- /dev/null +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/opaque_atom_adt.erl @@ -0,0 +1,9 @@ +-module(opaque_atom_adt). +-export([atom/1]). + +-opaque opaque_atom() :: atom(). + +-spec atom(atom()) -> opaque_atom(). + +atom(Atom) -> + Atom. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index f5275e66b5..d0a01351f3 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -171,18 +171,33 @@ start_link(T) -> info({gen_sctp, Sock}) -> lists:flatmap(fun(K) -> info(K, Sock) end, - [{socket, sockname}, - {peer, peername}, + [{socket, socknames}, + {peer, peernames}, {statistics, getstat}]). info({K,F}, Sock) -> case inet:F(Sock) of {ok, V} -> - [{K,V}]; + [{K, map(F,V)}]; _ -> [] end. +%% inet:{sock,peer}names/1 returns [{Addr, Port}] but the port number +%% should be the same in each tuple. Map to a {[Addr], Port} tuple if +%% so. +map(K, [{_, Port} | _] = APs) + when K == socknames; + K == peernames -> + try [A || {A,P} <- APs, P == Port orelse throw(?MODULE)] of + As -> {As, Port} + catch + ?MODULE -> APs + end; + +map(_, V) -> + V. + %% --------------------------------------------------------------------------- %% # init/1 %% --------------------------------------------------------------------------- @@ -549,7 +564,7 @@ accept_peer(_, []) -> ok; accept_peer(Sock, Matches) -> - {RAddrs, _} = ok(inet:peername(Sock)), + RAddrs = [A || {A,_} <- ok(inet:peernames(Sock))], diameter_peer:match(RAddrs, Matches) orelse x({accept, RAddrs, Matches}), ok. diff --git a/lib/kernel/doc/src/application.xml b/lib/kernel/doc/src/application.xml index 29eaf348a9..016151891c 100644 --- a/lib/kernel/doc/src/application.xml +++ b/lib/kernel/doc/src/application.xml @@ -239,10 +239,19 @@ Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code> <desc> <p>Sets the value of the configuration parameter <c><anno>Par</anno></c> for <c><anno>Application</anno></c>.</p> - <p><c>set_env/3</c> uses the standard <c>gen_server</c> timeout - value (5000 ms). A <c><anno>Timeout</anno></c> argument can be provided + <p><c>set_env/4</c> uses the standard <c>gen_server</c> timeout + value (5000 ms). The <c>timeout</c> option can be provided if another timeout value is useful, for example, in situations where the application controller is heavily loaded.</p> + <p>If <c>set_env/4</c> is called before the application is loaded, + the application environment values specified in the <c>Application.app</c> + file will override the ones previously set. This is also true for application + reloads.</p> + <p>The <c>persistent</c> option can be set to <c>true</c> + when there is a need to guarantee parameters set with <c>set_env/4</c> + will not be overridden by the ones defined in the application resource + file on load. This means persistent values will stick after the application + is loaded and also on application reload.</p> <warning> <p>Use this function only if you know what you are doing, that is, on your own applications. It is very application @@ -406,9 +415,11 @@ Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code> <p>Removes the configuration parameter <c><anno>Par</anno></c> and its value for <c><anno>Application</anno></c>.</p> <p><c>unset_env/2</c> uses the standard <c>gen_server</c> - timeout value (5000 ms). A <c><anno>Timeout</anno></c> argument can be + timeout value (5000 ms). The <c>timeout</c> option can be provided if another timeout value is useful, for example, in situations where the application controller is heavily loaded.</p> + <p><c>unset_env/3</c> also allows the persistent option to be passed + (see <c>set_env/4</c> above).</p> <warning> <p>Use this function only if you know what you are doing, that is, on your own applications. It is very application diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index c3bf1ac012..76a80553b0 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -285,16 +285,18 @@ info() -> set_env(Application, Key, Val) -> application_controller:set_env(Application, Key, Val). --spec set_env(Application, Par, Val, Timeout) -> 'ok' when +-spec set_env(Application, Par, Val, Opts) -> 'ok' when Application :: atom(), Par :: atom(), Val :: term(), - Timeout :: timeout(). + Opts :: [{timeout, timeout()} | {persistent, boolean()}]. set_env(Application, Key, Val, infinity) -> - application_controller:set_env(Application, Key, Val, infinity); + set_env(Application, Key, Val, [{timeout, infinity}]); set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 -> - application_controller:set_env(Application, Key, Val, Timeout). + set_env(Application, Key, Val, [{timeout, Timeout}]); +set_env(Application, Key, Val, Opts) when is_list(Opts) -> + application_controller:set_env(Application, Key, Val, Opts). -spec unset_env(Application, Par) -> 'ok' when Application :: atom(), @@ -303,15 +305,17 @@ set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 -> unset_env(Application, Key) -> application_controller:unset_env(Application, Key). --spec unset_env(Application, Par, Timeout) -> 'ok' when +-spec unset_env(Application, Par, Opts) -> 'ok' when Application :: atom(), Par :: atom(), - Timeout :: timeout(). + Opts :: [{timeout, timeout()} | {persistent, boolean()}]. unset_env(Application, Key, infinity) -> - application_controller:unset_env(Application, Key, infinity); + unset_env(Application, Key, [{timeout, infinity}]); unset_env(Application, Key, Timeout) when is_integer(Timeout), Timeout>=0 -> - application_controller:unset_env(Application, Key, Timeout). + unset_env(Application, Key, [{timeout, Timeout}]); +unset_env(Application, Key, Opts) when is_list(Opts) -> + application_controller:unset_env(Application, Key, Opts). -spec get_env(Par) -> 'undefined' | {'ok', Val} when Par :: atom(), diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 1a4473593a..ed13035104 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -461,14 +461,16 @@ permit_application(ApplName, Flag) -> set_env(AppName, Key, Val) -> - gen_server:call(?AC, {set_env, AppName, Key, Val}). -set_env(AppName, Key, Val, Timeout) -> - gen_server:call(?AC, {set_env, AppName, Key, Val}, Timeout). + gen_server:call(?AC, {set_env, AppName, Key, Val, []}). +set_env(AppName, Key, Val, Opts) -> + Timeout = proplists:get_value(timeout, Opts, 5000), + gen_server:call(?AC, {set_env, AppName, Key, Val, Opts}, Timeout). unset_env(AppName, Key) -> - gen_server:call(?AC, {unset_env, AppName, Key}). -unset_env(AppName, Key, Timeout) -> - gen_server:call(?AC, {unset_env, AppName, Key}, Timeout). + gen_server:call(?AC, {unset_env, AppName, Key, []}). +unset_env(AppName, Key, Opts) -> + Timeout = proplists:get_value(timeout, Opts, 5000), + gen_server:call(?AC, {unset_env, AppName, Key, Opts}, Timeout). %%%----------------------------------------------------------------- %%% call-back functions from gen_server @@ -609,8 +611,8 @@ check_para([Else | _ParaList], AppName) -> | {'change_application_data', _, _} | {'permit_application', atom() | {'application',atom(),_},_} | {'start_application', _, _} - | {'unset_env', _, _} - | {'set_env', _, _, _}. + | {'unset_env', _, _, _} + | {'set_env', _, _, _, _}. -spec handle_call(calls(), {pid(), term()}, state()) -> {'noreply', state()} | {'reply', term(), state()}. @@ -858,13 +860,25 @@ handle_call(which_applications, _From, S) -> end, S#state.running), {reply, Reply, S}; -handle_call({set_env, AppName, Key, Val}, _From, S) -> +handle_call({set_env, AppName, Key, Val, Opts}, _From, S) -> ets:insert(ac_tab, {{env, AppName, Key}, Val}), - {reply, ok, S}; + case proplists:get_value(persistent, Opts, false) of + true -> + Fun = fun(Env) -> lists:keystore(Key, 1, Env, {Key, Val}) end, + {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}}; + false -> + {reply, ok, S} + end; -handle_call({unset_env, AppName, Key}, _From, S) -> +handle_call({unset_env, AppName, Key, Opts}, _From, S) -> ets:delete(ac_tab, {env, AppName, Key}), - {reply, ok, S}; + case proplists:get_value(persistent, Opts, false) of + true -> + Fun = fun(Env) -> lists:keydelete(Key, 1, Env) end, + {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}}; + false -> + {reply, ok, S} + end; handle_call({control_application, AppName}, {Pid, _Tag}, S) -> Control = S#state.control, @@ -1640,6 +1654,16 @@ merge_env([{App, AppEnv1} | T], Env2, Res) -> merge_env([], Env2, Res) -> Env2 ++ Res. +%% Changes the environment for the given application +%% If there is no application, an empty one is created +change_app_env(Env, App, Fun) -> + case get_env_key(App, Env) of + {value, AppEnv, RestEnv} -> + [{App, Fun(AppEnv)} | RestEnv]; + _ -> + [{App, Fun([])} | Env] + end. + %% Merges envs for an application. Env2 overrides Env1 merge_app_env(Env1, Env2) -> merge_app_env(Env1, Env2, []). diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 9ec8a15861..ff62297f2d 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -33,7 +33,7 @@ permit_false_start_local/1, permit_false_start_dist/1, script_start/1, nodedown_start/1, init2973/0, loop2973/0, loop5606/1]). --export([config_change/1, +-export([config_change/1, persistent_env/1, distr_changed_tc1/1, distr_changed_tc2/1, ensure_started/1, ensure_all_started/1, shutdown_func/1, do_shutdown/1, shutdown_timeout/1]). @@ -53,7 +53,8 @@ all() -> load_use_cache, ensure_started, {group, reported_bugs}, start_phases, script_start, nodedown_start, permit_false_start_local, permit_false_start_dist, get_key, get_env, ensure_all_started, - {group, distr_changed}, config_change, shutdown_func, shutdown_timeout]. + {group, distr_changed}, config_change, shutdown_func, shutdown_timeout, + persistent_env]. groups() -> [{reported_bugs, [], @@ -1987,6 +1988,50 @@ get_appls([_ | T], Res) -> get_appls([], Res) -> Res. +persistent_env(suite) -> + []; +persistent_env(doc) -> + ["Test set_env/4 and unset_env/3 with persistent true"]; +persistent_env(Conf) when is_list(Conf) -> + ok = application:set_env(appinc, own2, persist, [{persistent, true}]), + ok = application:set_env(appinc, key1, persist, [{persistent, true}]), + + %% own_env1 and own2 are set in appinc + ok = application:load(appinc()), + {ok, value1} = application:get_env(appinc, own_env1), + {ok, persist} = application:get_env(appinc, own2), + {ok, persist} = application:get_env(appinc, key1), + + %% Changing the environment after loaded reflects and should persist + ok = application:set_env(appinc, own_env1, persist, [{persistent, true}]), + {ok, persist} = application:get_env(appinc, own_env1), + {ok, persist} = application:get_env(appinc, own2), + {ok, persist} = application:get_env(appinc, key1), + + %% On reload, own_env1, own2 and key1 should all persist + ok = application:unload(appinc), + ok = application:load(appinc()), + {ok, persist} = application:get_env(appinc, own_env1), + {ok, persist} = application:get_env(appinc, own2), + {ok, persist} = application:get_env(appinc, key1), + + %% Unset own_env1 and key1, own2 should still persist + ok = application:unset_env(appinc, own_env1, [{persistent, true}]), + ok = application:unset_env(appinc, key1, [{persistent, true}]), + undefined = application:get_env(appinc, own_env1), + {ok, persist} = application:get_env(appinc, own2), + undefined = application:get_env(appinc, key1), + + %% own_env1 should be back to its application value on reload + ok = application:unload(appinc), + ok = application:load(appinc()), + {ok, value1} = application:get_env(appinc, own_env1), + {ok, persist} = application:get_env(appinc, own2), + undefined = application:get_env(appinc, key1), + + %% Clean up + ok = application:unload(appinc). + %%%----------------------------------------------------------------- %%% Tests the 'shutdown_func' kernel config parameter %%%----------------------------------------------------------------- diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 5d5f2e5b91..eaf96d0230 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -367,8 +367,11 @@ </func> <func> - <name>stop() -> ok </name> + <name>stop() -> ok | {error, Reason}</name> <fsummary>Stops the SSH application.</fsummary> + <type> + <v>Reason = term()</v> + </type> <desc> <p>Stops the SSH application. See also <seealso marker="kernel:application">application(3)</seealso></p> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 9f571adba2..d50d5a0cb3 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -32,8 +32,8 @@ shell/1, shell/2, shell/3]). %%-------------------------------------------------------------------- --spec start() -> ok. --spec start(permanent | transient | temporary) -> ok. +-spec start() -> ok | {error, term()}. +-spec start(permanent | transient | temporary) -> ok | {error, term()}. %% %% Description: Starts the ssh application. Default type %% is temporary. see application(3) @@ -51,7 +51,7 @@ start(Type) -> application:start(ssh, Type). %%-------------------------------------------------------------------- --spec stop() -> ok. +-spec stop() -> ok | {error, term()}. %% %% Description: Stops the ssh application. %%-------------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 3462b98172..070a2db5a8 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -157,7 +157,7 @@ init([Role, Socket, SshOpts]) -> %%-------------------------------------------------------------------- -spec open_channel(pid(), string(), iodata(), integer(), integer(), - timeout()) -> {open, channel_id()} | {open_error, term(), string(), string()}. + timeout()) -> {open, channel_id()} | {error, term()}. %%-------------------------------------------------------------------- open_channel(ConnectionHandler, ChannelType, ChannelSpecificData, InitialWindowSize, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 7edc6554ca..c3bdeb1a54 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -626,7 +626,7 @@ handle_options(Opts0, _Role) -> user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), psk_identity = handle_option(psk_identity, Opts, undefined), srp_identity = handle_option(srp_identity, Opts, undefined), - ciphers = handle_option(ciphers, Opts, []), + ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), hd(Versions)), %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), @@ -769,15 +769,6 @@ validate_option(srp_identity, {Username, 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([]), - try cipher_suites(Version, Value) - catch - exit:_ -> - throw({error, {options, {ciphers, Value}}}); - error:_-> - throw({error, {options, {ciphers, Value}}}) - end; validate_option(reuse_session, Value) when is_function(Value) -> Value; validate_option(reuse_sessions, Value) when is_boolean(Value) -> @@ -937,16 +928,26 @@ emulated_options([Opt|Opts], Inet, Emulated) -> emulated_options([], Inet,Emulated) -> {Inet, Emulated}. -cipher_suites(Version, []) -> +handle_cipher_option(Value, Version) when is_list(Value) -> + try binary_cipher_suites(Version, Value) of + Suites -> + Suites + catch + exit:_ -> + throw({error, {options, {ciphers, Value}}}); + error:_-> + throw({error, {options, {ciphers, Value}}}) + end. +binary_cipher_suites(Version, []) -> %% Defaults to all supported suits ssl_cipher:suites(Version); -cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility +binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], - cipher_suites(Version, Ciphers); -cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> + binary_cipher_suites(Version, Ciphers); +binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], - cipher_suites(Version, Ciphers); + binary_cipher_suites(Version, Ciphers); -cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> +binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites() ++ ssl_cipher:psk_suites(Version) @@ -954,18 +955,18 @@ cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> Supported = ssl_cipher:filter_suites(Supported0), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of [] -> - Supported; + Supported; %% Defaults to all supported suits Ciphers -> Ciphers end; -cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> +binary_cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> %% Format: ["RC4-SHA","RC4-MD5"] Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0], - cipher_suites(Version, Ciphers); -cipher_suites(Version, Ciphers0) -> + binary_cipher_suites(Version, Ciphers); +binary_cipher_suites(Version, Ciphers0) -> %% Format: "RC4-SHA:RC4-MD5" Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], - cipher_suites(Version, Ciphers). + binary_cipher_suites(Version, Ciphers). unexpected_format(Error) -> lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index ddc511c652..2e216b32fa 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -86,6 +86,7 @@ basic_tests() -> [app, alerts, send_close, + version_option, connect_twice, connect_dist, clear_pem_cache @@ -1072,6 +1073,13 @@ send_close(Config) when is_list(Config) -> {error, _} = ssl:send(SslS, "Hello world"). %%-------------------------------------------------------------------- +version_option() -> + [{doc, "Use version option and do no specify ciphers list. Bug specified incorrect ciphers"}]. +version_option(Config) when is_list(Config) -> + Versions = proplists:get_value(supported, ssl:versions()), + [version_option_test(Config, Version) || Version <- Versions]. + +%%-------------------------------------------------------------------- close_transport_accept() -> [{doc,"Tests closing ssl socket when waiting on ssl:transport_accept/1"}]. @@ -3488,3 +3496,28 @@ shutdown_both_result(Socket, client) -> peername_result(S) -> ssl:peername(S). + +version_option_test(Config, Version) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result, []}}, + {options, [{active, false}, {versions, [Version]}| ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result, []}}, + {options, [{active, false}, {versions, [Version]}| ClientOpts]}]), + + ct:log("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 21cf8e4149..3df24bf688 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.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> @@ -171,6 +171,10 @@ <p>Returns a list of all tables at the node. Named tables are given by their names, unnamed tables are given by their table identifiers.</p> + <p>There is no guarantee of consistency in the returned list. Tables created + or deleted by other processes "during" the ets:all() call may or may + not be included in the list. Only tables created/deleted <em>before</em> + ets:all() is called are guaranteed to be included/excluded.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 4741bef6b9..f53c6e1278 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -135,9 +135,10 @@ pattern({tuple,Line,Ps}, St0) -> pattern({map,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{map,Line,TPs},St1}; -pattern({map_field_exact,Line,Key,V0}, St0) -> - {V,St1} = pattern(V0, St0), - {{map_field_exact,Line,Key,V},St1}; +pattern({map_field_exact,Line,Key0,V0}, St0) -> + {Key,St1} = pattern(Key0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_exact,Line,Key,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{struct,Line,Tag,TPs},TPsvs,St1}; @@ -310,9 +311,10 @@ expr({tuple,Line,Es0}, St0) -> expr({map,Line,Es0}, St0) -> {Es1,St1} = expr_list(Es0, St0), {{map,Line,Es1},St1}; -expr({map,Line,Var,Es0}, St0) -> - {Es1,St1} = expr_list(Es0, St0), - {{map,Line,Var,Es1},St1}; +expr({map,Line,Arg0,Es0}, St0) -> + {Arg1,St1} = expr(Arg0, St0), + {Es1,St2} = expr_list(Es0, St1), + {{map,Line,Arg1,Es1},St2}; expr({map_field_assoc,Line,K0,V0}, St0) -> {K,St1} = expr(K0, St0), {V,St2} = expr(V0, St1), diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index d18387568d..974583bc28 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -45,10 +45,13 @@ -type restart() :: 'permanent' | 'transient' | 'temporary'. -type shutdown() :: 'brutal_kill' | timeout(). -type worker() :: 'worker' | 'supervisor'. --type sup_name() :: {'local', Name :: atom()} | {'global', Name :: atom()}. +-type sup_name() :: {'local', Name :: atom()} + | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()}. -type sup_ref() :: (Name :: atom()) | {Name :: atom(), Node :: node()} | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()} | pid(). -type child_spec() :: {Id :: child_id(), StartFunc :: mfargs(), diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index e8405ab9a4..ff4502f0b9 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -101,7 +101,16 @@ handle_cast(_, State) -> {noreply, State}. handle_info({'EXIT', Pid, Reason}, State) when State#state.pid =:= Pid -> - report_error(child_terminated, Reason, State), + case Reason of + normal -> + ok; + shutdown -> + ok; + {shutdown, _Term} -> + ok; + _ -> + report_error(child_terminated, Reason, State) + end, {stop, Reason, State#state{pid = undefined}}; handle_info(_, State) -> {noreply, State}. diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index 94b4397a9c..43e679f7ed 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -38,7 +38,7 @@ -export([attributes/1, expr/1, guard/1, init/1, pattern/1, strict/1, update/1, otp_5915/1, otp_7931/1, otp_5990/1, - otp_7078/1, otp_7101/1]). + otp_7078/1, otp_7101/1, maps/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [attributes, expr, guard, init, - pattern, strict, update, {group, tickets}]. + pattern, strict, update, maps, {group, tickets}]. groups() -> [{tickets, [], @@ -402,7 +402,22 @@ update(Config) when is_list(Config) -> ], ?line run(Config, Ts), ok. - + +maps(Config) when is_list(Config) -> + Ts = [<<"-record(rr, {a,b,c}). + t() -> + R0 = id(#rr{a=1,b=2,c=3}), + R1 = id(#rr{a=4,b=5,c=6}), + [{R0,R1}] = + maps:to_list(#{#rr{a=1,b=2,c=3} => #rr{a=4,b=5,c=6}}), + #{#rr{a=1,b=2,c=3} := #rr{a=1,b=2,c=3}} = + #{#rr{a=1,b=2,c=3} => R1}#{#rr{a=1,b=2,c=3} := R0}, + ok. + + id(X) -> X. + ">>], + run(Config, Ts, [strict_record_tests]), + ok. otp_5915(doc) -> "Strict record tests in guards."; diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 82c3e7ecaf..8dc8b2c291 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -75,6 +75,7 @@ -export([otp_9932/1]). -export([otp_9423/1]). -export([otp_10182/1]). +-export([ets_all/1]). -export([memory_check_summary/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -151,6 +152,7 @@ all() -> otp_10182, otp_9932, otp_9423, + ets_all, memory_check_summary]. % MUST BE LAST @@ -5565,7 +5567,19 @@ otp_10182(Config) when is_list(Config) -> ets:delete(Db), In = Out. - +%% Test that ets:all include/exclude tables that we know are created/deleted +ets_all(Config) when is_list(Config) -> + Pids = [spawn_link(fun() -> ets_all_run() end) || _ <- [1,2]], + receive after 3*1000 -> ok end, + [begin unlink(P), exit(P,kill) end || P <- Pids], + ok. + +ets_all_run() -> + Table = ets:new(undefined, []), + true = lists:member(Table, ets:all()), + ets:delete(Table), + false = lists:member(Table, ets:all()), + ets_all_run(). % diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 067663feb4..cd723bcd4d 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang. dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -170,7 +170,30 @@ case $system in fi SHLIB_EXTRACT_ALL="" ;; - *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*) + *-openbsd*) + # Not available on all versions: check for include file. + AC_CHECK_HEADER(dlfcn.h, [ + SHLIB_CFLAGS="-fpic" + SHLIB_LD="${CC}" + SHLIB_LDFLAGS="$LDFLAGS -shared" + SHLIB_SUFFIX=".so" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + ], [ + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_SUFFIX="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ]) + SHLIB_EXTRACT_ALL="" + ;; + *-netbsd*|*-freebsd*|*-dragonfly*) # Not available on all versions: check for include file. AC_CHECK_HEADER(dlfcn.h, [ SHLIB_CFLAGS="-fpic" diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index e24d6ceacb..dcf905db24 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -487,6 +487,7 @@ init([]) -> ok end, test_server_sup:cleanup_crash_dumps(), + test_server_sup:util_start(), State = #state{jobs=[],finish=false}, TI0 = test_server:init_target_info(), TargetHost = test_server_sup:hoststr(), @@ -1055,6 +1056,7 @@ handle_info(_, State) -> %% test suites (if any) and any possible remainting slave node terminate(_Reason, State) -> + test_server_sup:util_stop(), case State#state.trc of false -> ok; Sock -> test_server_node:stop_tracer_node(Sock) @@ -1725,30 +1727,33 @@ make_html_link(LinkName, Target, Explanation) -> ok = write_html_file(LinkName, H). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% start_minor_log_file(Mod, Func) -> AbsName +%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName %% Mod = atom() %% Func = atom() +%% ParallelTC = bool() %% AbsName = string() %% %% Create a minor log file for the test case Mod,Func,Args. The log file -%% will be stored in the log directory under the name <Mod>.<Func>.log. -%% Some header info will also be inserted into the log file. +%% will be stored in the log directory under the name <Mod>.<Func>.html. +%% Some header info will also be inserted into the log file. If the test +%% case runs in a parallel group, then to avoid clashing file names if the +%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html +%% is used. -start_minor_log_file(Mod, Func) -> +start_minor_log_file(Mod, Func, ParallelTC) -> MFA = {Mod,Func,1}, LogDir = get(test_server_log_dir_base), Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])), Name = downcase(Name0), AbsName = filename:join(LogDir, Name), - case file:read_file_info(AbsName) of - {error,_} -> %% normal case, unique name + case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of + false -> %% normal case, unique name start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA); - {ok,_} -> %% special case, duplicate names - {_,S,Us} = now(), + true -> %% special case, duplicate names + Tag = test_server_sup:unique_name(), Name1_0 = - lists:flatten(io_lib:format("~w.~w.~w.~w~ts", [Mod,Func,S, - trunc(Us/1000), - ?html_ext])), + lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag, + ?html_ext])), Name1 = downcase(Name1_0), AbsName1 = filename:join(LogDir, Name1), start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA) @@ -3631,7 +3636,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, TSDir = get(test_server_dir), print(major, "=case ~w:~w", [Mod, Func]), - MinorName = start_minor_log_file(Mod, Func), + MinorName = start_minor_log_file(Mod, Func, self() /= Main), print(minor, "<a name=\"top\"></a>", [], internal_raw), MinorBase = filename:basename(MinorName), print(major, "=logfile ~ts", [filename:basename(MinorName)]), diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 377aa21018..70ead42b1b 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -29,10 +29,12 @@ hostatom/0, hostatom/1, hoststr/0, hoststr/1, framework_call/2,framework_call/3,framework_call/4, format_loc/1, + util_start/0, util_stop/0, unique_name/0, call_trace/1]). -include("test_server_internal.hrl"). -define(crash_dump_tar,"crash_dumps.tar.gz"). -define(src_listing_ext, ".src.html"). +-record(util_state, {starter, latest_name}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap(Timeout,Scale,Pid) -> Handle @@ -583,6 +585,69 @@ downcase([], Result) -> lists:reverse(Result). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_start() -> ok +%% +%% Start local utility process +util_start() -> + Starter = self(), + case whereis(?MODULE) of + undefined -> + spawn_link(fun() -> + register(?MODULE, self()), + util_loop(#util_state{starter=Starter}) + end); + _Pid -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_stop() -> ok +%% +%% Stop local utility process +util_stop() -> + try (?MODULE ! {self(),stop}) of + _ -> + receive {?MODULE,stopped} -> ok + after 5000 -> exit(whereis(?MODULE), kill) + end + catch + _:_ -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% unique_name() -> string() +%% +unique_name() -> + ?MODULE ! {self(),unique_name}, + receive {?MODULE,Name} -> Name + after 5000 -> exit({?MODULE,no_util_process}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_loop(State) -> ok +%% +util_loop(State) -> + receive + {From,unique_name} -> + {_,S,Us} = now(), + Ms = trunc(Us/1000), + Name = lists:flatten(io_lib:format("~w.~w", [S,Ms])), + if Name == State#util_state.latest_name -> + timer:sleep(1), + self() ! {From,unique_name}, + util_loop(State); + true -> + From ! {?MODULE,Name}, + util_loop(State#util_state{latest_name = Name}) + end; + {From,stop} -> + catch unlink(State#util_state.starter), + From ! {?MODULE,stopped}, + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% call_trace(TraceSpecFile) -> ok %% %% Read terms on format {m,Mod} | {f,Mod,Func} diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3a868f1300..f007f780eb 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -664,6 +664,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_function" "is_integer" "is_list" + "is_map" "is_number" "is_pid" "is_port" @@ -715,7 +716,8 @@ resulting regexp is surrounded by \\_< and \\_>." "pos_integer" "string" "term" - "timeout") + "timeout" + "map") "Erlang type specs types")) (eval-and-compile @@ -772,6 +774,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_function" "is_integer" "is_list" + "is_map" "is_number" "is_pid" "is_port" @@ -791,6 +794,7 @@ resulting regexp is surrounded by \\_< and \\_>." "list_to_tuple" "load_module" "make_ref" + "map_size" "max" "min" "module_loaded" |