diff options
Diffstat (limited to 'lib')
118 files changed, 2315 insertions, 1241 deletions
diff --git a/lib/Makefile b/lib/Makefile index 5128241563..6301c882b2 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -25,12 +25,12 @@ ERTS_APPLICATIONS = stdlib sasl kernel compiler # Then these have to be build ERLANG_APPLICATIONS = tools test_server common_test runtime_tools \ - inets xmerl edoc erl_docgen + inets xmerl edoc erl_docgen parsetools # These are only build if -a is given to otp_build or make is used directly ALL_ERLANG_APPLICATIONS = snmp otp_mibs erl_interface asn1 jinterface \ wx debugger reltool gs \ - ic mnesia crypto orber os_mon parsetools syntax_tools \ + ic mnesia crypto orber os_mon syntax_tools \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 531a4935fe..30f493a2df 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -1040,7 +1040,7 @@ get_file_list1(Stream,Dir,Includes,Acc) -> Ret = io:get_line(Stream,''), case Ret of eof -> - file:close(Stream), + ok = file:close(Stream), lists:reverse(Acc); FileName -> SuffixedNameList = @@ -1926,8 +1926,9 @@ read_config_file(ModuleName) -> Includes = [I || {i,I} <- Options], read_config_file1(ModuleName,Includes); {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) + Error = "error reading asn1 config file: " ++ + file:format_error(Reason), + throw({error,Error}) end. read_config_file1(ModuleName,[]) -> case filename:extension(ModuleName) of @@ -1945,8 +1946,9 @@ read_config_file1(ModuleName,[H|T]) -> {error,enoent} -> read_config_file1(ModuleName,T); {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) + Error = "error reading asn1 config file: " ++ + file:format_error(Reason), + throw({error,Error}) end. get_config_info(CfgList,InfoType) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f94f3b56bc..b9f2cb876a 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2464,7 +2464,7 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); {'OCTET STRING',CType,_} -> - normalize_octetstring(S,Value,CType); + normalize_octetstring(S0, Value, CType); {'NULL',_CType,_} -> %%normalize_null(Value); 'NULL'; @@ -2612,20 +2612,9 @@ normalize_octetstring(S,Value,CType) -> fun normalize_octetstring/3,[]); {Name,String} when is_atom(Name) -> normalize_octetstring(S,String,CType); - List when is_list(List) -> - %% check if list elements are valid octet values - lists:map(fun([])-> ok; - (H)when H > 255-> - asn1ct:warning("not legal octet value ~p in OCTET STRING, ~p~n", - [H,List],S, - "not legal octet value ~p in OCTET STRING"); - (_)-> ok - end, List), - List; - Other -> - asn1ct:warning("unknown default value ~p~n",[Other],S, - "unknown default value"), - Value + _ -> + Item = S#state.value, + throw(asn1_error(S, Item, illegal_octet_string_value)) end. normalize_objectidentifier(S, Value) -> @@ -2642,16 +2631,19 @@ normalize_objectdescriptor(Value) -> normalize_real(Value) -> Value. -normalize_enumerated(S, Id, {Base,Ext}) -> +normalize_enumerated(S, Id0, NNL) -> + {Id,_} = lookup_enum_value(S, Id0, NNL), + Id. + +lookup_enum_value(S, Id, {Base,Ext}) -> %% Extensible ENUMERATED. - normalize_enumerated(S, Id, Base++Ext); -normalize_enumerated(S, #'Externalvaluereference'{value=Id}, - NamedNumberList) -> - normalize_enumerated(S, Id, NamedNumberList); -normalize_enumerated(S, Id, NamedNumberList) when is_atom(Id) -> - case lists:keymember(Id, 1, NamedNumberList) of - true -> - Id; + lookup_enum_value(S, Id, Base++Ext); +lookup_enum_value(S, #'Externalvaluereference'{value=Id}, NNL) -> + lookup_enum_value(S, Id, NNL); +lookup_enum_value(S, Id, NNL) when is_atom(Id) -> + case lists:keyfind(Id, 1, NNL) of + {_,_}=Ret -> + Ret; false -> throw(asn1_error(S, S#state.value, {undefined,Id})) end. @@ -3088,7 +3080,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> Ct=maybe_illicit_implicit_tag(open_type,Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 'INTEGER' -> - check_integer(S,[],Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; @@ -3786,8 +3777,9 @@ resolv_value(S,Val) -> resolv_value1(S,Id). resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) -> - case catch resolve_namednumber(S,S#state.type,Name) of - V when is_integer(V) -> V; + case catch resolve_namednumber(S, S#state.type, Name) of + V when is_integer(V) -> + V; _ -> case get_referenced_type(S,ERef) of {Err,_Reason} when Err == error; Err == 'EXIT' -> @@ -3840,21 +3832,20 @@ resolve_value_from_object(S,Object,FieldName) -> end. - resolve_namednumber(S,#typedef{typespec=Type},Name) -> case Type#type.def of {'ENUMERATED',NameList} -> - NamedNumberList=check_enumerated(S,NameList,Type#type.constraint), - N = normalize_enumerated(S,Name,NamedNumberList), - {value,{_,V}} = lists:keysearch(N,1,NamedNumberList), - V; + resolve_namednumber_1(S, Name, NameList, Type); {'INTEGER',NameList} -> - NamedNumberList = check_enumerated(S,NameList,Type#type.constraint), - {value,{_,V}} = lists:keysearch(Name,1,NamedNumberList), - V; + resolve_namednumber_1(S, Name, NameList, Type); _ -> not_enumerated end. + +resolve_namednumber_1(S, Name, NameList, Type) -> + NamedNumberList = check_enumerated(S, NameList, Type#type.constraint), + {_,N} = lookup_enum_value(S, Name, NamedNumberList), + N. check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> {RefMod,CTDef} = get_referenced_type(S,Type#type.def), @@ -3935,9 +3926,9 @@ check_constraint(S,{simpletable,Type}) -> #'Externaltypereference'{} -> ERef = check_externaltypereference(S,C), {simpletable,ERef#'Externaltypereference'.type}; - #type{def=#'Externaltypereference'{type=T}} -> - check_externaltypereference(S,C#type.def), - {simpletable,T}; + #type{def=#'Externaltypereference'{}=ExtTypeRef} -> + ERef = check_externaltypereference(S, ExtTypeRef), + {simpletable,ERef#'Externaltypereference'.type}; {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set {_,TDef} = get_referenced_type(S,ERef), case TDef#typedef.typespec of @@ -6811,6 +6802,8 @@ asn1_error(#state{mname=Where}, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error(illegal_octet_string_value) -> + "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({missing_mandatory_fields,Fields,Obj}) -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 71d870b4ce..4707e517b4 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -71,7 +71,7 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - open_output_file(ErlFile), + _ = open_output_file(ErlFile), asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), @@ -190,7 +190,7 @@ pgen_check_defaultval(Erules,Module) -> "********~n~n",[X]) end, lists:foreach(Fun,CheckObjects), - file:close(IoDevice); + ok = file:close(IoDevice); _ -> ok end, gen_check_defaultval(Erules,Module,CheckObjects). @@ -1124,7 +1124,7 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - open_output_file(File), + _ = open_output_file(File), gen_hrlhead(Module). %% EMIT functions ************************ diff --git a/lib/asn1/src/asn1ct_table.erl b/lib/asn1/src/asn1ct_table.erl index a5eb6d0413..2eca80eda3 100644 --- a/lib/asn1/src/asn1ct_table.erl +++ b/lib/asn1/src/asn1ct_table.erl @@ -22,34 +22,25 @@ %% Table abstraction module for ASN.1 compiler -export([new/1]). --export([new/2]). -export([new_reuse/1]). --export([new_reuse/2]). -export([exists/1]). -export([size/1]). -export([insert/2]). -export([lookup/2]). -export([match/2]). -export([to_list/1]). --export([delete/1]). % TODO: Remove (since we run in a separate process) +-export([delete/1]). -%% Always creates a new table -new(Table) -> new(Table, []). -new(Table, Options) -> - TableId = case get(Table) of - undefined -> - ets:new(Table, Options); - _ -> - delete(Table), - ets:new(Table, Options) - end, +%% Always create a new table. +new(Table) -> + undefined = get(Table), %Assertion. + TableId = ets:new(Table, []), put(Table, TableId). -%% Only create it if it doesn't exist yet -new_reuse(Table) -> new_reuse(Table, []). -new_reuse(Table, Options) -> - not exists(Table) andalso new(Table, Options). +%% Only create it if it doesn't exist yet. +new_reuse(Table) -> + not exists(Table) andalso new(Table). exists(Table) -> get(Table) =/= undefined. @@ -63,14 +54,17 @@ match(Table, MatchSpec) -> ets:match(get(Table), MatchSpec). to_list(Table) -> ets:tab2list(get(Table)). +%% Deleting tables is no longer strictly necessary since each compilation +%% runs in separate process, but it will reduce memory consumption +%% especially when many compilations are run in parallel. + delete(Tables) when is_list(Tables) -> [delete(T) || T <- Tables], true; delete(Table) when is_atom(Table) -> - case get(Table) of + case erase(Table) of undefined -> true; TableId -> - ets:delete(TableId), - erase(Table) + ets:delete(TableId) end. diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 85199c65ec..33f4379173 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -36,7 +36,7 @@ process(Stream,Lno,R) -> process(io:get_line(Stream, ''), Stream,Lno+1,R). process(eof, Stream,Lno,R) -> - file:close(Stream), + ok = file:close(Stream), lists:flatten(lists:reverse([{'$end',Lno}|R])); diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index a86c963b9d..be8b967cf0 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -352,7 +352,7 @@ random_unnamed_bit_string(M, C) -> random(Upper) -> {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + _ = random:seed(A1, A2, A3), random:uniform(Upper). size_random(C) -> diff --git a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 index 8dc5f3d7e1..74fa97e7aa 100644 --- a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 @@ -18,6 +18,8 @@ Ext1 ::= ENUMERATED { magenta(9) } +SubExt1 ::= Ext1 ( blue | orange | black ) + Noext ::= ENUMERATED { blue(0), red(1), diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index 6451f81c01..930b44cea6 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -19,7 +19,7 @@ -module(error_SUITE). -export([suite/0,all/0,groups/0, - already_defined/1,enumerated/1,objects/1]). + already_defined/1,enumerated/1,objects/1,values/1]). -include_lib("test_server/include/test_server.hrl"). @@ -29,9 +29,11 @@ all() -> [{group,p}]. groups() -> - [{p,parallel(),[already_defined, - enumerated, - objects]}]. + [{p,parallel(), + [already_defined, + enumerated, + objects, + values]}]. parallel() -> case erlang:system_info(schedulers) > 1 of @@ -138,6 +140,25 @@ objects(Config) -> } = run(P, Config), ok. +values(Config) -> + M = 'Values', + P = {M, + <<"Values DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " os1 OCTET STRING ::= \"abc\"\n" + " os2 OCTET STRING ::= 42\n" + " os3 OCTET STRING ::= { 1, 3 }\n" + "END\n">>}, + {error, + [ + {structured_error,{M,2},asn1ct_check, + illegal_octet_string_value}, + {structured_error,{M,3},asn1ct_check, + illegal_octet_string_value}, + {structured_error,{M,4},asn1ct_check, + illegal_octet_string_value} + ] + } = run(P, Config), + ok. run({Mod,Spec}, Config) -> diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index c66adaf949..878518be11 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -59,6 +59,10 @@ main(ber) -> common(ber). common(Erule) -> + roundtrip('SubExt1', blue), + roundtrip('SubExt1', orange), + roundtrip('SubExt1', black), + roundtrip('Seq', {'Seq',blue,42}), roundtrip('Seq', {'Seq',red,42}), roundtrip('Seq', {'Seq',green,42}), 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/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 682f7adbc2..2486d486ed 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -882,7 +882,7 @@ valfun_4(_, _) -> verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), - [assert_term(Term, Vst0) || Term <- List], + foreach(fun (Term) -> assert_term(Term, Vst0) end, List), assert_term(Src, Vst0), Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), @@ -909,7 +909,7 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> branch_state(Fail, Vst). %% -%% Special state handling for setelement/3 and the set_tuple_element/3 instruction. +%% Special state handling for setelement/3 and set_tuple_element/3 instructions. %% A possibility for garbage collection must not occur between setelement/3 and %% set_tuple_element/3. %% diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 5588f1fbe5..e79fe41f9b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -626,7 +626,8 @@ core_passes() -> {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}, + {core_fold_after_inlining,fun test_any_inliner/1, + fun core_fold_module_after_inlining/1}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -1172,6 +1173,9 @@ test_core_inliner(#compile{options=Opts}) -> end, Opts) end. +test_any_inliner(St) -> + test_old_inliner(St) orelse test_core_inliner(St). + core_old_inliner(#compile{code=Code0,options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), {ok,St#compile{code=Code}}. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e302e2324d..e2b9213891 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -353,7 +353,12 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), - bsm_an(Expr); + case move_case_into_arg(Case, Sub) of + impossible -> + bsm_an(Expr); + Other -> + expr(Other, Ctxt, sub_new_preserve_types(Sub)) + end; Other -> expr(Other, Ctxt, Sub) end; @@ -1940,7 +1945,9 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> %% last clause is guaranteed to match so if there is only one clause %% with a pattern containing only variables then rewrite to a let. -eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> +eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0, + guard=#c_literal{val=true}, + body=B}]}=Case, Sub) -> Es = case cerl:is_c_values(E) of true -> cerl:values_es(E); false -> [E] @@ -1955,7 +1962,7 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> %% %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ... %% - %% because SomeSideEffect() would be called evaluated twice. + %% because SomeSideEffect() would be evaluated twice. %% %% Instead we must evaluate the case expression in an outer let %% like this: @@ -1964,11 +1971,19 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> %% let <X,Y> = <NewVar,NewVar> in ... %% Vs = make_vars([], length(Es)), - {true,Bs} = cerl_clauses:match_list(Ps0, Vs), - {Ps,As} = unzip(Bs), - InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), - Let = cerl:c_let(Vs, E, InnerLet), - expr(Let, sub_new(Sub)); + case cerl_clauses:match_list(Ps0, Vs) of + {false,_} -> + %% This can only happen if the Core Erlang code is + %% handwritten or generated by another code generator + %% than v3_core. Assuming that the Core Erlang program + %% is correct, the clause will always match at run-time. + Case; + {true,Bs} -> + {Ps,As} = unzip(Bs), + InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), + Let = cerl:c_let(Vs, E, InnerLet), + expr(Let, sub_new(Sub)) + end; eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. @@ -2596,6 +2611,77 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> value, Sub) end. +move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, + body=InnerArg0}=Outer, + clauses=InnerClauses}=Inner, Sub) -> + %% + %% case let <OuterVars> = <OuterArg> in <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% let <OuterVars> = <OuterArg> + %% in case <InnerArg> of <InnerClauses> end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0), + InnerArg = body(InnerArg0, ScopeSub), + Outer#c_let{vars=OuterVars,arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, + clauses=[OuterCa0,OuterCb]}=Outer, + clauses=InnerClauses}=Inner0, Sub) -> + case is_failing_clause(OuterCb) of + true -> + #c_clause{pats=OuterPats0,guard=OuterGuard0, + body=InnerArg0} = OuterCa0, + %% + %% case case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> <InnerArg> + %% <OuterCb> + %% ... + %% end of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> + %% case <InnerArg> of <InnerClauses> end + %% <OuterCb> + %% end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0), + OuterGuard = guard(OuterGuard0, ScopeSub), + InnerArg = body(InnerArg0, ScopeSub), + Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses}, + OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard, + body=Inner}, + Outer#c_case{arg=OuterArg, + clauses=[OuterCa,OuterCb]}; + false -> + impossible + end; +move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, + clauses=InnerClauses}=Inner, _Sub) -> + %% + %% case do <OuterArg> <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% do <OuterArg> + %% case <InnerArg> of <InerClauses> end + %% + Outer#c_seq{arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(_, _) -> + impossible. + %% In guards only, rewrite a case in a let argument like %% %% let <Var> = case <> of diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 291443f824..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,133 +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), - 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=LAnno,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}, - 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=LAnno,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}, - 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=LAnno, - 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=LAnno, - 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), @@ -1025,143 +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}, - {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=LAnno,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}, - 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=LAnno,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}, - 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=LAnno, - 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=LAnno, - 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}, @@ -1169,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, []). @@ -1189,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/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 1a521c3591..aa222c48de 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -24,7 +24,7 @@ dehydrated_itracer/1,nested_tries/1, seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, unsafe_case/1,nomatch_shadow/1,reversed_annos/1, - map_core_test/1]). + map_core_test/1,eval_case/1]). -include_lib("test_server/include/test_server.hrl"). @@ -50,7 +50,7 @@ groups() -> [{p,test_lib:parallel(), [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, - map_core_test + map_core_test,eval_case ]}]. @@ -76,6 +76,7 @@ end_per_group(_GroupName, Config) -> ?comp(nomatch_shadow). ?comp(reversed_annos). ?comp(map_core_test). +?comp(eval_case). try_it(Mod, Conf) -> Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), diff --git a/lib/compiler/test/core_SUITE_data/eval_case.core b/lib/compiler/test/core_SUITE_data/eval_case.core new file mode 100644 index 0000000000..f2776e2b1f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/eval_case.core @@ -0,0 +1,34 @@ +module 'eval_case' ['eval_case'/0] + attributes [] +'eval_case'/0 = + fun () -> + case <> of + <> when 'true' -> + case apply 'do_case'/0() of + <'ok'> when 'true' -> + 'ok' + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'eval_case',0}}] ) + -| ['compiler_generated'] ) + end +'do_case'/0 = + fun () -> + case let <_cor0> = + apply 'id'/1(42) + in let <_cor1> = + call 'erlang':'+' + (_cor0, 7) + in {'x',_cor1} of + <{'x',49}> when 'true' -> + 'ok' + end +'id'/1 = + fun (_cor0) -> _cor0 +end 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/debugger/src/dbg_wx_filedialog_win.erl b/lib/debugger/src/dbg_wx_filedialog_win.erl index c8ecb7b5d4..ea34295067 100644 --- a/lib/debugger/src/dbg_wx_filedialog_win.erl +++ b/lib/debugger/src/dbg_wx_filedialog_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -242,16 +242,13 @@ handle_event(#wx{event=#wxList{itemIndex=Index}}, {noreply, State0} end; -handle_event(#wx{event=#wxCommand{type=command_text_updated, cmdString=Wanted}}, +handle_event(#wx{event=#wxCommand{type=command_text_updated, cmdString=Wanted}}, State = #state{ptext=Previous, completion=Comp}) -> case Previous =:= undefined orelse lists:prefix(Wanted, Previous) of - true -> - case Comp of - {Temp,_} -> wxWindow:destroy(Temp); - undefined -> ok - end, + true -> + destroy_completion(Comp), {noreply, State#state{ptext=Wanted,completion=undefined}}; - false -> + false -> {noreply, show_completion(Wanted, State)} end; @@ -310,8 +307,7 @@ handle_event(#wx{event=#wxSize{size={Width,_}}}, State = #state{list=LC}) -> end), {noreply, State}; -handle_event(Event,State) -> - io:format("~p Got ~p ~n",[self(), Event]), +handle_event(_Event,State) -> {noreply, State}. handle_info(_Msg, State) -> @@ -419,8 +415,9 @@ show_completion(Wanted, State = #state{text=TC, win=Win, list=LC, completion=Com end. destroy_completion(undefined) -> ok; -destroy_completion({Window, _}) -> +destroy_completion({Window, _LB}) -> Parent = wxWindow:getParent(Window), + wxWindow:hide(Window), wxWindow:destroy(Window), wxWindow:refresh(Parent). diff --git a/lib/debugger/src/dbg_wx_mon.erl b/lib/debugger/src/dbg_wx_mon.erl index 4a01492cf5..4ab03985d3 100644 --- a/lib/debugger/src/dbg_wx_mon.erl +++ b/lib/debugger/src/dbg_wx_mon.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 @@ -148,7 +148,7 @@ init2(CallingPid, Mode, SFile, GS) -> win = Win, focus = undefined, - coords = {20,20}, + coords = {-1,-1}, intdir = element(2, file:get_cwd()), pinfos = [], diff --git a/lib/debugger/src/dbg_wx_mon_win.erl b/lib/debugger/src/dbg_wx_mon_win.erl index 0071b27027..d94eb14937 100644 --- a/lib/debugger/src/dbg_wx_mon_win.erl +++ b/lib/debugger/src/dbg_wx_mon_win.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 @@ -617,8 +617,6 @@ handle_event(#wx{userData=Data, _WinInfo) -> Data; handle_event(_Event, _WinInfo) -> -%% FIXME - io:format("Ev: ~p~n",[_Event]), ignore. %%==================================================================== diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 1ac796bb4c..4438466bb0 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.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 @@ -125,7 +125,7 @@ init(Pid, Parent, Meta, TraceWin, BackTrace, Strings) -> dbg_wx_winman:insert(Title, Window), %% Initial process state - State1 = #state{win=Win, coords={0,0}, pid=Pid, meta=Meta, + State1 = #state{win=Win, coords={-1,-1}, pid=Pid, meta=Meta, status={idle,null,null}, stack={1,1}, strings=[str_on]}, diff --git a/lib/debugger/src/dbg_wx_view.erl b/lib/debugger/src/dbg_wx_view.erl index 6242b9d0e0..fc7ffc0d56 100644 --- a/lib/debugger/src/dbg_wx_view.erl +++ b/lib/debugger/src/dbg_wx_view.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. 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 @@ -72,7 +72,7 @@ init(GS, Env, Mod, Title) -> Win2, int:all_breaks(Mod)), - try loop(#state{gs=GS, win=Win3, coords={0,0}, mod=Mod}) + try loop(#state{gs=GS, win=Win3, coords={-1,-1}, mod=Mod}) catch _E:normal -> exit(normal); _E:_R -> diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index 4870c87d74..8a6798c6ad 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -647,19 +647,27 @@ make_sub_bin(Bin0) -> %% give the same result. dynamic(Config) when is_list(Config) -> - ?line dynamic_1(fun dynamic_big/5), - ?line dynamic_1(fun dynamic_little/5), + Ps = [spawn_monitor(fun() -> + dynamic_1(Fun) + end) || Fun <- [fun dynamic_big/5, + fun dynamic_little/5]], + [receive + {'DOWN',Ref,process,Pid,normal} -> + ok; + {'DOWN',Ref,process,Pid,Exit} -> + ?t:fail({Pid,Exit}) + end || {Pid,Ref} <- Ps], ok. dynamic_1(Dynamic) -> - <<Lpad:128>> = erlang:md5([0]), - <<Rpad:128>> = erlang:md5([1]), - <<Int:128>> = erlang:md5([2]), - 8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). + <<Lpad:64,_/binary>> = erlang:md5([0]), + <<Rpad:64,_/binary>> = erlang:md5([1]), + <<Int:64,_/binary>> = erlang:md5([2]), + 2145 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). -dynamic_2(129, _, Count) -> Count; +dynamic_2(64+1, _, Count) -> Count; dynamic_2(Bef, Data, Count0) -> - Count = dynamic_3(Bef, 128-Bef, Data, Count0), + Count = dynamic_3(Bef, 64-Bef, Data, Count0), dynamic_2(Bef+1, Data, Count). dynamic_3(_, -1, _, Count) -> Count; @@ -680,13 +688,13 @@ dynamic_big(Bef, N, Int, Lpad, Rpad) -> <<MaskedInt:N>> = NumBin, %% Construct the binary in two different ways. - Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(128-Bef-N)>>), - Bin = <<Lpad:Bef,Int:N,Rpad:(128-Bef-N)>>, + Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(64-Bef-N)>>), + Bin = <<Lpad:Bef,Int:N,Rpad:(64-Bef-N)>>, %% Further verify the result by matching. LpadMasked = Lpad band ((1 bsl Bef) - 1), - RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), - Rbits = (128-Bef-N), + RpadMasked = Rpad band ((1 bsl (64-Bef-N)) - 1), + Rbits = (64-Bef-N), <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin), ok. @@ -696,13 +704,13 @@ dynamic_little(Bef, N, Int, Lpad, Rpad) -> <<MaskedInt:N/little>> = NumBin, %% Construct the binary in two different ways. - Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(128-Bef-N)/little>>), - Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(128-Bef-N)/little>>, + Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(64-Bef-N)/little>>), + Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(64-Bef-N)/little>>, %% Further verify the result by matching. LpadMasked = Lpad band ((1 bsl Bef) - 1), - RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), - Rbits = (128-Bef-N), + RpadMasked = Rpad band ((1 bsl (64-Bef-N)) - 1), + Rbits = (64-Bef-N), <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin), ok. 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/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 74702102f0..264a533a52 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -454,7 +454,7 @@ check_type(#tag{line = L, data = Data}, P0, Ls, Ts) -> check_type(#t_def{type = Type}, P, Ls, Ts) -> check_type(Type, P, Ls, Ts); check_type(#t_type{name = Name, args = Args}, P, Ls, Ts) -> - check_used_type(Name, Args, P, Ls), + _ = check_used_type(Name, Args, P, Ls), check_types3(Args++Ts, P, Ls); check_type(#t_var{}, P, Ls, Ts) -> check_types3(Ts, P, Ls); diff --git a/lib/gs/doc/src/gs.xml b/lib/gs/doc/src/gs.xml index e0d7fb20da..7b589d002d 100644 --- a/lib/gs/doc/src/gs.xml +++ b/lib/gs/doc/src/gs.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2000</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -39,7 +39,7 @@ graphical user interface. </p> <p> - GS is deprecated and will be removed in the R16 release. + GS is deprecated and will be removed in the 18.0 release. </p> </warning> <p>The Graphics System, GS, is easy to learn and diff --git a/lib/jinterface/doc/src/jinterface_users_guide.xml b/lib/jinterface/doc/src/jinterface_users_guide.xml index aaf84e2e3d..5dfe5c0c6d 100644 --- a/lib/jinterface/doc/src/jinterface_users_guide.xml +++ b/lib/jinterface/doc/src/jinterface_users_guide.xml @@ -112,6 +112,10 @@ <cell align="left" valign="middle"><seealso marker="java/com/ericsson/otp/erlang/OtpErlangTuple">OtpErlangTuple</seealso></cell> </row> <row> + <cell align="left" valign="middle">map</cell> + <cell align="left" valign="middle"><seealso marker="java/com/ericsson/otp/erlang/OtpErlangMap">OtpErlangMap</seealso></cell> + </row> + <row> <cell align="left" valign="middle">term</cell> <cell align="left" valign="middle"><seealso marker="java/com/ericsson/otp/erlang/OtpErlangObject">OtpErlangObject</seealso></cell> </row> diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java new file mode 100644 index 0000000000..7c1cf84e98 --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -0,0 +1,293 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-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% + */ +package com.ericsson.otp.erlang; + +import java.io.Serializable; + +/** + * Provides a Java representation of Erlang maps. Maps are created from one or + * more arbitrary Erlang terms. + * + * <p> + * The arity of the map is the number of elements it contains. The keys and + * values can be retrieved as arrays and the value for a key can be queried. + * + */ +public class OtpErlangMap extends OtpErlangObject implements Serializable, + Cloneable { + // don't change this! + private static final long serialVersionUID = -6410770117696198497L; + + private static final OtpErlangObject[] NO_ELEMENTS = new OtpErlangObject[0]; + + private OtpErlangObject[] keys = NO_ELEMENTS; + private OtpErlangObject[] values = NO_ELEMENTS; + + /** + * Create a map from an array of keys and an array of values. + * + * @param keys + * the array of terms to create the map keys from. + * @param values + * the array of terms to create the map values from. + * + * @exception java.lang.IllegalArgumentException + * if any array is empty (null) or contains null elements. + */ + public OtpErlangMap(final OtpErlangObject[] keys, + final OtpErlangObject[] values) { + this(keys, 0, keys.length, values, 0, values.length); + } + + /** + * Create a map from an array of terms. + * + * @param elems + * the array of terms to create the map from. + * @param start + * the offset of the first term to insert. + * @param vcount + * the number of terms to insert. + * + * @exception java.lang.IllegalArgumentException + * if any array is empty (null) or contains null elements. + */ + public OtpErlangMap(final OtpErlangObject[] keys, final int kstart, + final int kcount, final OtpErlangObject[] values, final int vstart, + final int vcount) { + if (keys == null || values == null) { + throw new java.lang.IllegalArgumentException( + "Map content can't be null"); + } else if (kcount != vcount) { + throw new java.lang.IllegalArgumentException( + "Map keys and values must have same arity"); + } else if (vcount < 1) { + this.keys = NO_ELEMENTS; + this.values = NO_ELEMENTS; + } else { + this.keys = new OtpErlangObject[vcount]; + for (int i = 0; i < vcount; i++) { + if (keys[kstart + i] != null) { + this.keys[i] = keys[kstart + i]; + } else { + throw new java.lang.IllegalArgumentException( + "Map key cannot be null (element" + (kstart + i) + + ")"); + } + } + this.values = new OtpErlangObject[vcount]; + for (int i = 0; i < vcount; i++) { + if (values[vstart + i] != null) { + this.values[i] = values[vstart + i]; + } else { + throw new java.lang.IllegalArgumentException( + "Map value cannot be null (element" + (vstart + i) + + ")"); + } + } + } + } + + /** + * Create a map from a stream containing a map encoded in Erlang external + * format. + * + * @param buf + * the stream containing the encoded map. + * + * @exception OtpErlangDecodeException + * if the buffer does not contain a valid external + * representation of an Erlang map. + */ + public OtpErlangMap(final OtpInputStream buf) + throws OtpErlangDecodeException { + final int arity = buf.read_map_head(); + + if (arity > 0) { + keys = new OtpErlangObject[arity]; + values = new OtpErlangObject[arity]; + + for (int i = 0; i < arity; i++) { + keys[i] = buf.read_any(); + } + for (int i = 0; i < arity; i++) { + values[i] = buf.read_any(); + } + } else { + keys = NO_ELEMENTS; + values = NO_ELEMENTS; + } + } + + /** + * Get the arity of the map. + * + * @return the number of elements contained in the map. + */ + public int arity() { + return keys.length; + } + + /** + * Get the specified value from the map. + * + * @param key + * the key of the requested value. + * + * @return the requested value, of null if key is not a valid key. + */ + public OtpErlangObject get(final OtpErlangObject key) { + if (key == null) { + return null; + } + for (int i = 0; i < keys.length; i++) { + if (key.equals(keys[i])) { + return values[i]; + } + } + return null; + } + + /** + * Get all the keys from the map as an array. + * + * @return an array containing all of the map's keys. + */ + public OtpErlangObject[] keys() { + final OtpErlangObject[] res = new OtpErlangObject[arity()]; + System.arraycopy(keys, 0, res, 0, res.length); + return res; + } + + /** + * Get all the values from the map as an array. + * + * @return an array containing all of the map's values. + */ + public OtpErlangObject[] values() { + final OtpErlangObject[] res = new OtpErlangObject[arity()]; + System.arraycopy(values, 0, res, 0, res.length); + return res; + } + + /** + * Get the string representation of the map. + * + * @return the string representation of the map. + */ + @Override + public String toString() { + int i; + final StringBuffer s = new StringBuffer(); + final int arity = values.length; + + s.append("#{"); + + for (i = 0; i < arity; i++) { + if (i > 0) { + s.append(","); + } + s.append(keys[i].toString()); + s.append(" => "); + s.append(values[i].toString()); + } + + s.append("}"); + + return s.toString(); + } + + /** + * Convert this map to the equivalent Erlang external representation. + * + * @param buf + * an output stream to which the encoded map should be written. + */ + @Override + public void encode(final OtpOutputStream buf) { + final int arity = values.length; + + buf.write_map_head(arity); + + for (int i = 0; i < arity; i++) { + buf.write_any(keys[i]); + } + for (int i = 0; i < arity; i++) { + buf.write_any(values[i]); + } + } + + /** + * Determine if two maps are equal. Maps are equal if they have the same + * arity and all of the elements are equal. + * + * @param o + * the map to compare to. + * + * @return true if the maps have the same arity and all the elements are + * equal. + */ + @Override + public boolean equals(final Object o) { + if (!(o instanceof OtpErlangMap)) { + return false; + } + + final OtpErlangMap t = (OtpErlangMap) o; + final int a = arity(); + + if (a != t.arity()) { + return false; + } + + for (int i = 0; i < a; i++) { + if (!keys[i].equals(t.keys[i])) { + return false; // early exit + } + } + for (int i = 0; i < a; i++) { + if (!values[i].equals(t.values[i])) { + return false; // early exit + } + } + + return true; + } + + @Override + protected int doHashCode() { + final OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); + final int a = arity(); + hash.combine(a); + for (int i = 0; i < a; i++) { + hash.combine(keys[i].hashCode()); + } + for (int i = 0; i < a; i++) { + hash.combine(values[i].hashCode()); + } + return hash.valueOf(); + } + + @Override + public Object clone() { + final OtpErlangMap newMap = (OtpErlangMap) super.clone(); + newMap.values = values.clone(); + return newMap; + } +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpExternal.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpExternal.java index 45a82d6c94..fa0fe18e95 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpExternal.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpExternal.java @@ -85,6 +85,9 @@ public class OtpExternal { /** The tag used for new style references */ public static final int newRefTag = 114; + /** The tag used for maps */ + public static final int mapTag = 116; + /** The tag used for old Funs */ public static final int funTag = 117; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index 9dc1728346..0d1342d796 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -1202,6 +1202,9 @@ public class OtpInputStream extends ByteArrayInputStream { case OtpExternal.newRefTag: return new OtpErlangRef(this); + case OtpExternal.mapTag: + return new OtpErlangMap(this); + case OtpExternal.portTag: return new OtpErlangPort(this); @@ -1244,4 +1247,21 @@ public class OtpInputStream extends ByteArrayInputStream { throw new OtpErlangDecodeException("Uknown data type: " + tag); } } + + public int read_map_head() throws OtpErlangDecodeException { + int arity = 0; + final int tag = read1skip_version(); + + // decode the map header and get arity + switch (tag) { + case OtpExternal.mapTag: + arity = read4BE(); + break; + + default: + throw new OtpErlangDecodeException("Not valid map tag: " + tag); + } + + return arity; + } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index 78f47aa32f..a78423db44 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -974,4 +974,9 @@ public class OtpOutputStream extends ByteArrayOutputStream { write_atom(function); write_long(arity); } + + public void write_map_head(final int arity) { + write1(OtpExternal.mapTag); + write4BE(arity); + } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files b/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files index 1390542194..62fa7f990e 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files @@ -74,6 +74,7 @@ ERL = \ OtpErlangShort\ OtpErlangString\ OtpErlangTuple \ + OtpErlangMap \ OtpErlangUInt \ OtpErlangUShort diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index de8d611efc..cb725164cd 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -37,7 +37,9 @@ erl_exit_with_reason_any_term/1, java_exit_with_reason_any_term/1, status_handler_localStatus/1, status_handler_remoteStatus/1, - status_handler_connAttempt/1]). + status_handler_connAttempt/1, + maps/1 + ]). -include_lib("common_test/include/ct.hrl"). -include("test_server_line.hrl"). @@ -103,7 +105,8 @@ fundamental() -> nodename, % Nodename.java register_and_whereis, % RegisterAndWhereis.java get_names, % GetNames.java - boolean_atom % BooleanAtom.java + boolean_atom, % BooleanAtom.java + maps % Maps.java ]. ping() -> @@ -675,6 +678,17 @@ status_handler_connAttempt(Config) when is_list(Config) -> "NodeStatusHandler", [erlang:get_cookie(),node(),?status_handler_connAttempt]). +%%%----------------------------------------------------------------- +maps(doc) -> + ["Maps.java: " + "Tests OtpErlangMap encoding, decoding, toString, get"]; +maps(suite) -> + []; +maps(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "Maps", + []). %%%----------------------------------------------------------------- %%% INTERNAL FUNCTIONS diff --git a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src index 2a3dca463b..a15ed1aa63 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src +++ b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src @@ -46,7 +46,8 @@ JAVA_FILES = \ MboxPing.java \ MboxSendReceive.java \ MboxLinkUnlink.java \ - NodeStatusHandler.java + NodeStatusHandler.java \ + Maps.java CLASS_FILES = $(JAVA_FILES:.java=.class) diff --git a/lib/jinterface/test/jinterface_SUITE_data/Maps.java b/lib/jinterface/test/jinterface_SUITE_data/Maps.java new file mode 100644 index 0000000000..136a665f23 --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/Maps.java @@ -0,0 +1,108 @@ +import java.util.Arrays; + +import com.ericsson.otp.erlang.OtpErlangAtom; +import com.ericsson.otp.erlang.OtpErlangDecodeException; +import com.ericsson.otp.erlang.OtpErlangList; +import com.ericsson.otp.erlang.OtpErlangLong; +import com.ericsson.otp.erlang.OtpErlangMap; +import com.ericsson.otp.erlang.OtpInputStream; +import com.ericsson.otp.erlang.OtpOutputStream; + +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2010. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +class Maps { + + /* + * Implements test case jinterface_SUITE:maps/1 + * + * Test the class OtpErlangMap + */ + + @SuppressWarnings("resource") + public static void main(final String argv[]) { + + runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 0 }, "#{}", 1); + runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 1, 100, 0, 1, 97, 100, + 0, 1, 98 }, "#{a => b}", 2); + // make sure keys are sorted here, jinterface doesn't reorder them + runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 100, 0, 1, 97, + 106, 97, 1 }, "#{2 => [],a => 1}", 3); + runTest(new byte[] { (byte) 131, 116, 0, 0, 0, 1, 104, 1, 97, 3, 108, + 0, 0, 0, 1, 100, 0, 1, 114, 106 }, "#{{3} => [r]}", 4); + + try { + // #{2 => [],a => 1} + final OtpErlangMap map = new OtpErlangMap(new OtpInputStream( + new byte[] { (byte) 131, 116, 0, 0, 0, 2, 97, 2, 100, 0, 1, + 97, 106, 97, 1 })); + + if (map.arity() != 2) { + fail(5); + } + if (!new OtpErlangLong(1).equals(map.get(new OtpErlangAtom("a")))) { + fail(6); + } + if (!new OtpErlangList().equals(map.get(new OtpErlangLong(2)))) { + fail(7); + } + if (map.get(new OtpErlangLong(1)) != null) { + fail(8); + } + } catch (final OtpErlangDecodeException e) { + fail(99); + } + + } + + @SuppressWarnings("resource") + private static void runTest(final byte[] in, final String out, final int err) { + try { + final OtpInputStream is = new OtpInputStream(in); + + final OtpErlangMap map = new OtpErlangMap(is); + final String output = map.toString(); + if (!output.equals(out)) { + fail("toString mismatch " + output + " <> " + out, err); + } + + final OtpOutputStream os = new OtpOutputStream(map); + final byte[] outArray0 = os.toByteArray(); + final byte[] outArray = new byte[outArray0.length + 1]; + System.arraycopy(outArray0, 0, outArray, 1, outArray0.length); + outArray[0] = (byte) 131; + if (!Arrays.equals(in, outArray)) { + fail("encode error " + Arrays.toString(outArray), err); + } + } catch (final OtpErlangDecodeException e) { + fail("decode error " + e.getMessage(), err); + } catch (final Exception e) { + fail("error " + e.getMessage(), err); + } + } + + private static void fail(final int reason) { + System.exit(reason); + } + + private static void fail(final String str, final int reason) { + System.out.println(str); + System.exit(reason); + } +} 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 4e8ba1b78a..76a80553b0 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.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 @@ -132,7 +132,7 @@ ensure_all_started(Application, Type) -> {ok, Started} -> {ok, lists:reverse(Started)}; {error, Reason, Started} -> - [stop(App) || App <- Started], + _ = [stop(App) || App <- Started], {error, Reason} end. @@ -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/src/application_master.erl b/lib/kernel/src/application_master.erl index 68f78c6eb8..bc15b5a7de 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.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 @@ -27,7 +27,7 @@ -include("application_master.hrl"). --record(state, {child, appl_data, children = [], procs = 0, gleader}). +-record(state, {child, appl_data, children = [], procs = 0, gleader, req=[]}). %%----------------------------------------------------------------- %% Func: start_link/1 @@ -205,22 +205,25 @@ terminate_loop(Child, State) -> %%----------------------------------------------------------------- %% The Application Master is linked to *all* processes in the group -%% (application). +%% (application). %%----------------------------------------------------------------- handle_msg({get_child, Tag, From}, State) -> - From ! {Tag, get_child_i(State#state.child)}, - State; + get_child_i(State, Tag, From); handle_msg({stop, Tag, From}, State) -> catch terminate(normal, State), From ! {Tag, ok}, exit(normal); +handle_msg({child, Ref, GrandChild, Mod}, #state{req=Reqs0}=State) -> + {value, {_, Tag, From}, Reqs} = lists:keytake(Ref, 1, Reqs0), + From ! {Tag, {GrandChild, Mod}}, + State#state{req=Reqs}; handle_msg(_, State) -> State. - -terminate(Reason, State) -> - terminate_child(State#state.child, State), - kill_children(State#state.children), +terminate(Reason, State = #state{child=Child, children=Children, req=Reqs}) -> + _ = [From ! {Tag, error} || {_, Tag, From} <- Reqs], + terminate_child(Child, State), + kill_children(Children), exit(Reason). @@ -342,8 +345,8 @@ start_supervisor(Type, M, A) -> loop_it(Parent, Child, Mod, AppState) -> receive - {Parent, get_child} -> - Parent ! {self(), Child, Mod}, + {Parent, get_child, Ref} -> + Parent ! {child, Ref, Child, Mod}, loop_it(Parent, Child, Mod, AppState); {Parent, terminate} -> NewAppState = prep_stop(Mod, AppState), @@ -382,10 +385,15 @@ prep_stop(Mod, AppState) -> NewAppState end. -get_child_i(Child) -> - Child ! {self(), get_child}, - receive - {Child, GrandChild, Mod} -> {GrandChild, Mod} +get_child_i(#state{child=Child, req=Reqs}=State, Tag, From) -> + Ref = erlang:make_ref(), + case erlang:is_process_alive(Child) of + true -> + Child ! {self(), get_child, Ref}, + State#state{req=[{Ref, Tag, From}|Reqs]}; + false -> + From ! {Tag, error}, + State end. terminate_child_i(Child, State) -> diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 9ec8a15861..ccb3760309 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_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 @@ -33,10 +33,10 @@ 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]). + shutdown_func/1, do_shutdown/1, shutdown_timeout/1, shutdown_deadlock/1]). -define(TESTCASE, testcase_name). -define(testcase, ?config(?TESTCASE, Config)). @@ -53,7 +53,9 @@ 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, + shutdown_deadlock, + persistent_env]. groups() -> [{reported_bugs, [], @@ -960,7 +962,7 @@ nodedown_start(Conf) when is_list(Conf) -> ensure_started(suite) -> []; ensure_started(doc) -> ["Test application:ensure_started/1."]; -ensure_started(Conf) -> +ensure_started(_Conf) -> {ok, Fd} = file:open("app1.app", [write]), w_app1(Fd), @@ -980,7 +982,7 @@ ensure_started(Conf) -> ensure_all_started(suite) -> []; ensure_all_started(doc) -> ["Test application:ensure_all_started/1-2."]; -ensure_all_started(Conf) -> +ensure_all_started(_Conf) -> {ok, Fd1} = file:open("app1.app", [write]), w_app1(Fd1), @@ -1987,6 +1989,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 %%%----------------------------------------------------------------- @@ -2051,7 +2097,31 @@ shutdown_timeout(Config) when is_list(Config) -> end, ok. +%%%----------------------------------------------------------------- +%%% Provokes a (previous) application shutdown deadlock +%%%----------------------------------------------------------------- +shutdown_deadlock(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + code:add_path(filename:join([DataDir,deadlock])), + %% ok = rpc:call(Cp1, application, start, [sasl]), + ok = application:start(deadlock), + Tester = self(), + application:set_env(deadlock, fail_stop, Tester), + spawn(fun() -> Tester ! {stop, application:stop(deadlock)} end), + receive + {deadlock, Server} -> + spawn(fun() -> + Master = application_controller:get_master(deadlock), + Child = application_master:get_child(Master), + Tester ! {child, Child} + end), + timer:sleep(100), + erlang:display({self(), "Sending Continue", Server}), + Server ! continue + end, + [_|_] = application:which_applications(), + ok. %%----------------------------------------------------------------- diff --git a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app index 0c1001bed6..233c7a3f76 100644 --- a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app +++ b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app @@ -4,5 +4,5 @@ {applications, [kernel, stdlib, sasl]}, {modules, [deadlock]}, {mod, {deadlock, []}}, - {env, [{fail_start, false}]} + {env, [{fail_start, false}, {fail_stop, false}]} ]}. diff --git a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl index 5f68bf9078..3ef6105371 100644 --- a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl +++ b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl @@ -21,7 +21,7 @@ init([sup]) -> {ok, {{one_for_one, 5, 10}, [ { sasl_syslog_dm, {?MODULE, start_link, []}, - permanent, brutal_kill, worker, + permanent, 25000, worker, [deadlock] } ]}}; @@ -32,6 +32,8 @@ init([sup]) -> init([child]) -> case application:get_env(deadlock, fail_start) of {ok, false} -> + process_flag(trap_exit, true), + io:format("~p: Traps exit~n",[?MODULE]), %% we must not fail on the first init, otherwise supervisor %% terminates immediately {ok, []}; @@ -50,6 +52,14 @@ handle_info(_Msg, State) -> {noreply, State}. terminate(_Reason, _State) -> + case application:get_env(deadlock, fail_stop) of + {ok, false} -> ok; + {ok, Tester} -> + Tester ! {deadlock, self()}, + io:format("~p: Waiting in terminate (~p)~n",[?MODULE,Tester]), + receive continue -> ok end + end, + io:format("~p: terminates~n", [?MODULE]), ok. code_change(_OldVsn, State, _Extra) -> diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 0266047ee3..d5fbceff1e 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-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 @@ -21,26 +21,26 @@ detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({_, {T,Key}}) -> +get_details({Type, {T,Key}}) -> [{Key,Term}] = ets:lookup(T,Key), - {ok,{"Expanded Binary", Term, []}}; + {ok,{"Expanded Binary", {Type, Term}, []}}; get_details({cdv, Id}) -> {ok,Bin} = crashdump_viewer:expand_binary(Id), - {ok,{"Expanded Binary", Bin, []}}. + {ok,{"Expanded Binary", {cvd, Bin}, []}}. detail_pages() -> [{"Binary", fun init_bin_page/2}]. -init_bin_page(Parent,Bin) -> +init_bin_page(Parent,{Type,Bin}) -> cdv_multi_wx:start_link( Parent, - [{"Format \~p",cdv_html_wx,format_bin_fun("~p",Bin)}, - {"Format \~tp",cdv_html_wx,format_bin_fun("~tp",Bin)}, - {"Format \~w",cdv_html_wx,format_bin_fun("~w",Bin)}, - {"Format \~s",cdv_html_wx,format_bin_fun("~s",Bin)}, - {"Format \~ts",cdv_html_wx,format_bin_fun("~ts",Bin)}, - {"Hex",cdv_html_wx,hex_binary_fun(Bin)}, - {"Term",cdv_html_wx,binary_to_term_fun(Bin)}]). + [{"Format \~p",cdv_html_wx,{Type,format_bin_fun("~p",Bin)}}, + {"Format \~tp",cdv_html_wx,{Type,format_bin_fun("~tp",Bin)}}, + {"Format \~w",cdv_html_wx,{Type,format_bin_fun("~w",Bin)}}, + {"Format \~s",cdv_html_wx,{Type,format_bin_fun("~s",Bin)}}, + {"Format \~ts",cdv_html_wx,{Type,format_bin_fun("~ts",Bin)}}, + {"Hex",cdv_html_wx,{Type,hex_binary_fun(Bin)}}, + {"Term",cdv_html_wx,{Type,binary_to_term_fun(Bin)}}]). format_bin_fun(Format,Bin) -> fun() -> diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index fe77a41f59..b79c647f63 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-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 @@ -30,6 +30,7 @@ %% Records -record(state, {panel, + app, %% which tool is the user expand_table, expand_wins=[]}). @@ -38,16 +39,21 @@ start_link(ParentWin, Info) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([ParentWin, Fun]) when is_function(Fun) -> - init([ParentWin, Fun()]); +init([ParentWin, {App, Fun}]) when is_function(Fun) -> + init([ParentWin, {App, Fun()}]); init([ParentWin, {expand,HtmlText,Tab}]) -> - HtmlWin = observer_lib:html_window(ParentWin), - wxHtmlWindow:setPage(HtmlWin,HtmlText), - {HtmlWin, #state{panel=HtmlWin,expand_table=Tab}}; + init(ParentWin, HtmlText, Tab, cdv); +init([ParentWin, {App, {expand,HtmlText,Tab}}]) -> + init(ParentWin, HtmlText, Tab, App); +init([ParentWin, {App,HtmlText}]) -> + init(ParentWin, HtmlText, undefined, App); init([ParentWin, HtmlText]) -> + init(ParentWin, HtmlText, undefined, cdv). + +init(ParentWin, HtmlText, Tab, App) -> HtmlWin = observer_lib:html_window(ParentWin), wxHtmlWindow:setPage(HtmlWin,HtmlText), - {HtmlWin, #state{panel=HtmlWin}}. + {HtmlWin, #state{panel=HtmlWin,expand_table=Tab,app=App}}. %%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -78,7 +84,7 @@ handle_cast(Msg, State) -> handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked, linkInfo=#wxHtmlLinkInfo{href=Target}}}, - #state{expand_table=Tab}=State) -> + #state{expand_table=Tab, app=App}=State) -> NewState= case Target of "#Binary?" ++ BinSpec -> @@ -102,10 +108,12 @@ handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked, list_to_integer(Key2), list_to_integer(Key3)}}}, expand(Id,cdv_term_cb,State); + _ when App =:= obs -> + observer ! {open_link, Target}; _ -> cdv_virtual_list_wx:start_detail_win(Target), State - end, + end, {noreply, NewState}; handle_event(Event, State) -> diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index 6426cc0803..4451045012 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-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 @@ -21,23 +21,23 @@ detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({_, {T,Key}}) -> +get_details({Type, {T,Key}}) -> [{Key,Term}] = ets:lookup(T,Key), - {ok,{"Expanded Term", [Term, T], []}}. + {ok,{"Expanded Term", {Type,[Term, T]}, []}}. detail_pages() -> [{"Term", fun init_term_page/2}]. -init_term_page(ParentWin, [Term, Tab]) -> +init_term_page(ParentWin, {Type, [Term, Tab]}) -> Expanded = expand(Term, true), BinSaved = expand(Term, Tab), cdv_multi_wx:start_link( ParentWin, - [{"Format \~p",cdv_html_wx,format_term_fun("~p",BinSaved,Tab)}, - {"Format \~tp",cdv_html_wx,format_term_fun("~tp",BinSaved,Tab)}, - {"Format \~w",cdv_html_wx,format_term_fun("~w",BinSaved,Tab)}, - {"Format \~s",cdv_html_wx,format_term_fun("~s",Expanded,Tab)}, - {"Format \~ts",cdv_html_wx,format_term_fun("~ts",Expanded,Tab)}]). + [{"Format \~p",cdv_html_wx,{Type, format_term_fun("~p",BinSaved,Tab)}}, + {"Format \~tp",cdv_html_wx,{Type,format_term_fun("~tp",BinSaved,Tab)}}, + {"Format \~w",cdv_html_wx,{Type,format_term_fun("~w",BinSaved,Tab)}}, + {"Format \~s",cdv_html_wx,{Type,format_term_fun("~s",Expanded,Tab)}}, + {"Format \~ts",cdv_html_wx,{Type,format_term_fun("~ts",Expanded,Tab)}}]). format_term_fun(Format,Term,Tab) -> fun() -> @@ -56,8 +56,9 @@ expand(['#CDVBin',Offset,Size,Pos], true) -> {ok,Bin} = crashdump_viewer:expand_binary({Offset,Size,Pos}), Bin; expand(Bin, Tab) when is_binary(Bin), not is_boolean(Tab) -> - <<Preview:80, _/binary>> = Bin, Size = byte_size(Bin), + PrevSize = min(Size, 10) * 8, + <<Preview:PrevSize, _/binary>> = Bin, Hash = erlang:phash2(Bin), Key = {Preview, Size, Hash}, ets:insert(Tab, {Key,Bin}), diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 9f77891426..c279218707 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -146,7 +146,8 @@ all_or_expand(Tab,Term) -> Check = io_lib:format("~P",[Term,100]), Exp = Preview=/=Check, all_or_expand(Tab,Term,Preview,Exp). -all_or_expand(_Tab,_Term,Str,false) -> +all_or_expand(_Tab,Term,Str,false) + when not is_binary(Term) -> href_proc_port(lists:flatten(Str)); all_or_expand(Tab,Term,Preview,true) when not is_binary(Term) -> @@ -158,20 +159,16 @@ all_or_expand(Tab,Term,Preview,true) "&key2="++integer_to_list(Key2)++ "&key3="++integer_to_list(Key3)], "Click to expand above term")]; -all_or_expand(Tab,Bin,PreviewStr,true) when is_binary(Bin) -> - <<Preview:80, _/binary>> = Bin, +all_or_expand(Tab,Bin,_PreviewStr,_Expand) + when is_binary(Bin) -> Size = byte_size(Bin), + PrevSize = min(Size, 10) * 8, + <<Preview:PrevSize, _/binary>> = Bin, Hash = erlang:phash2(Bin), Key = {Preview, Size, Hash}, ets:insert(Tab,{Key,Bin}), - [href_proc_port(lists:flatten(PreviewStr), false), $\n, - href("TARGET=\"expanded\"", - ["#OBSBinary?key1="++integer_to_list(Preview)++ - "&key2="++integer_to_list(Size)++ - "&key3="++integer_to_list(Hash)], - "Click to expand above term")]. - - + Term = io_lib:format("~p", [['#OBSBin',Preview,Size,Hash]]), + href_proc_port(lists:flatten(Term), true). color(true) -> io_lib:format("BGCOLOR=\"#~2.16.0B~2.16.0B~2.16.0B\"", tuple_to_list(?BG_EVEN)); color(false) -> io_lib:format("BGCOLOR=\"#~2.16.0B~2.16.0B~2.16.0B\"", tuple_to_list(?BG_ODD)). @@ -242,7 +239,7 @@ href(Args,Link,Text) -> ["<A HREF=\"",Link,"\" ",Args,">",Text,"</A>"]. font(Args,Text) -> ["<FONT ",Args,">\n",Text,"\n</FONT>\n"]. -p(Text) -> +p(Text) -> ["<P>",Text,"</P>\n"]. br() -> "<BR>\n". @@ -336,34 +333,28 @@ href_proc_bin(From, T, Acc, LTB) -> {OffsetSizePos,Rest} = split($],T), BinStr = case string:tokens(OffsetSizePos,",.| \n") of - [Offset,Size,Pos] when From =:= cdv -> + [Offset,SizeStr,Pos] when From =:= cdv -> Id = {list_to_integer(Offset),10,list_to_integer(Pos)}, {ok,PreviewBin} = crashdump_viewer:expand_binary(Id), - PreviewStr = ["<<", - [integer_to_list(X)++"," || <<X:8>> <= PreviewBin], - "...(", - observer_lib:to_str({bytes,Size}), - ")>>"], + PreviewStr = preview_string(list_to_integer(SizeStr), PreviewBin), if LTB -> href("TARGET=\"expanded\"", ["#Binary?offset="++Offset++ - "&size="++Size++ + "&size="++SizeStr++ "&pos="++Pos], PreviewStr); true -> PreviewStr end; - [Preview,Size,Md5] when From =:= obs -> - PreviewBin = <<(list_to_integer(Preview)):80>>, - PreviewStr = ["<<", - [integer_to_list(X)++"," || <<X:8>> <= PreviewBin], - "...(", - observer_lib:to_str({bytes,list_to_integer(Size)}), - ")>>"], + [Preview,SizeStr,Md5] when From =:= obs -> + Size = list_to_integer(SizeStr), + PrevSize = min(Size, 10) * 8, + PreviewStr = preview_string(Size, + <<(list_to_integer(Preview)):PrevSize>>), if LTB -> href("TARGET=\"expanded\"", ["#OBSBinary?key1="++Preview++ - "&key2="++Size++ + "&key2="++SizeStr++ "&key3="++Md5], PreviewStr); true -> @@ -374,6 +365,35 @@ href_proc_bin(From, T, Acc, LTB) -> end, href_proc_port(Rest,[BinStr|Acc],LTB). +preview_string(Size, PreviewBin) when Size > 10 -> + ["<<", + remove_lgt(io_lib:format("~p",[PreviewBin])), + "...(", + observer_lib:to_str({bytes,Size}), + ")", + ">>"]; +preview_string(_, PreviewBin) -> + ["<<", + remove_lgt(io_lib:format("~p",[PreviewBin])), + ">>"]. + +remove_lgt(Deep) -> + remove_lgt_1(lists:flatten(Deep)). + +remove_lgt_1([$<,$<|Rest]) -> + [$>,$>|BinStr] = lists:reverse(Rest), + replace_lgt(lists:reverse(BinStr)). + +replace_lgt([$<|R]) -> + ["<"|replace_lgt(R)]; +replace_lgt([$>|R]) -> + [">"|replace_lgt(R)]; +replace_lgt([L=[_|_]|R]) -> + [replace_lgt(L)|replace_lgt(R)]; +replace_lgt([A|R]) -> + [A|replace_lgt(R)]; +replace_lgt([]) -> []. + split(Char,Str) -> split(Char,Str,[]). split(Char,[Char|Str],Acc) -> % match Char @@ -381,7 +401,6 @@ split(Char,[Char|Str],Acc) -> % match Char split(Char,[H|T],Acc) -> split(Char,T,[H|Acc]). - warn([]) -> []; warn(Warning) -> diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index e0f7bf482b..cedaf7d2b8 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -699,7 +699,9 @@ progress_handler(Caller,Env,Title,Str) -> register(?progress_handler,self()), wx:set_env(Env), PD = progress_dialog(Env,Title,Str), - progress_loop(Title,PD,Caller). + try progress_loop(Title,PD,Caller) + catch closed -> normal end. + progress_loop(Title,PD,Caller) -> receive {progress,{ok,done}} -> % to make wait_for_progress/0 return @@ -738,8 +740,12 @@ progress_dialog(_Env,Title,Str) -> PD. update_progress(PD,Value) -> - wxProgressDialog:update(PD,Value). + try wxProgressDialog:update(PD,Value) + catch _:_ -> throw(closed) %% Port or window have died + end. update_progress_text(PD,Text) -> - wxProgressDialog:update(PD,0,[{newmsg,Text}]). + try wxProgressDialog:update(PD,0,[{newmsg,Text}]) + catch _:_ -> throw(closed) %% Port or window have died + end. finish_progress(PD) -> wxProgressDialog:destroy(PD). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 988e04993c..3ffa5fc77d 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.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 @@ -136,9 +136,9 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, {noreply, State}; Callback -> [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = httpd:parse_query(Rest), - Id = {observer, {T,{list_to_integer(Key1), - list_to_integer(Key2), - list_to_integer(Key3)}}}, + Id = {obs, {T,{list_to_integer(Key1), + list_to_integer(Key2), + list_to_integer(Key3)}}}, Opened = case lists:keyfind(Id,1,Opened0) of false -> diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 4c385b76aa..ecb8e132fe 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.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 @@ -214,7 +214,7 @@ handle_event(#wx{event = #wxClose{}}, State) -> {stop, normal, State}; handle_event(#wx{id = ?ID_CDV, event = #wxCommand{type = command_menu_selected}}, State) -> - crashdump_viewer:start(), + spawn(crashdump_viewer, start, []), {noreply, State}; handle_event(#wx{id = ?wxID_EXIT, event = #wxCommand{type = command_menu_selected}}, State) -> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index b698beb558..f4657663e6 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.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 @@ -423,7 +423,7 @@ infile(Parent, Infilex, Options) -> end, case {St#yecc.errors, werror(St)} of {[], false} -> ok; - _ -> _ = file:delete(St#yecc.outfile) + _ -> _ = file:delete(St#yecc.outfile), ok end, Parent ! {self(), yecc_ret(St)}. diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 68ef04f20c..fea0854042 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -227,7 +227,9 @@ fetch_stats(Parent, Time) -> fetch_stats_loop(Parent, Time) -> erlang:system_flag(scheduler_wall_time, true), receive - _Msg -> erlang:system_flag(scheduler_wall_time, false) + _Msg -> + %% erlang:system_flag(scheduler_wall_time, false) + ok after Time -> _M = Parent ! {stats, 1, erlang:statistics(scheduler_wall_time), @@ -244,17 +246,6 @@ etop_collect(Collector) -> %% utilization in etop). Next time the flag will be true and then %% there will be a measurement. SchedulerWallTime = erlang:statistics(scheduler_wall_time), - - %% Turn off the flag while collecting data per process etc. - case erlang:system_flag(scheduler_wall_time,false) of - false -> - %% First time and the flag was false - start a monitoring - %% process to set the flag back to false when etop is stopped. - spawn(fun() -> flag_holder_proc(Collector) end); - _ -> - ok - end, - ProcInfo = etop_collect(processes(), []), Collector ! {self(),#etop_info{now = now(), @@ -264,13 +255,22 @@ etop_collect(Collector) -> memi = etop_memi(), procinfo = ProcInfo }}, + + case SchedulerWallTime of + undefined -> + spawn(fun() -> flag_holder_proc(Collector) end); + _ -> + ok + end, + erlang:system_flag(scheduler_wall_time,true). flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), receive {'DOWN',Ref,_,_,_} -> - erlang:system_flag(scheduler_wall_time,false) + %% erlang:system_flag(scheduler_wall_time,false) + ok end. etop_memi() -> diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index 7e9d7c984a..ad2a8005b9 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.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 @@ -1781,37 +1781,46 @@ otp_10463_upgrade_script_regexp(_Config) -> ok. no_dot_erlang(Conf) -> - PrivDir = priv_dir(Conf), + PrivDir = ?config(data_dir,Conf), {ok, OrigWd} = file:get_cwd(), try ok = file:set_cwd(PrivDir), - Erl = "\"" ++ filename:join([code:root_dir(),"bin","erl"]) ++ "\"", - Args = " -noinput -run io put_chars \"TESTOK\" -run erlang halt", + {ok, Wd} = file:get_cwd(), + io:format("Dir ~ts~n", [Wd]), + + Erl0 = filename:join([code:root_dir(),"bin","erl"]), + Erl = filename:nativename(Erl0), + Quote = "\"", + Args = " -noinput -run c pwd -run erlang halt", ok = file:write_file(".erlang", <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>), - case os:cmd(Erl ++ Args) of + CMD1 = Quote ++ Erl ++ Quote ++ Args , + case os:cmd(CMD1) of "DOT_ERLANG_READ" ++ _ -> ok; Other1 -> - io:format("Failed: ~ts~n",[Erl ++ Args]), + io:format("Failed: ~ts~n",[CMD1]), io:format("Expected: ~s ++ _~n",["DOT_ERLANG_READ "]), io:format("Got: ~ts~n",[Other1]), - exit(failed_to_start, test_error) + exit({failed_to_start, test_error}) end, NO_DOT_ERL = " -boot no_dot_erlang", - case os:cmd(Erl ++ NO_DOT_ERL ++ Args) of - "TESTOK" ++ _ -> ok; - Other2 -> - io:format("Failed: ~ts~n",[Erl ++ Args]), + CMD2 = Quote ++ Erl ++ Quote ++ NO_DOT_ERL ++ Args, + case lists:prefix(Wd, Other2 = os:cmd(CMD2)) of + true -> ok; + false -> + io:format("Failed: ~ts~n",[CMD2]), io:format("Expected: ~s~n",["TESTOK"]), io:format("Got: ~ts~n",[Other2]), - exit(failed_to_start, no_dot_erlang) + exit({failed_to_start, no_dot_erlang}) end after _ = file:delete(".erlang"), - ok = file:set_cwd(OrigWd) + ok = file:set_cwd(OrigWd), + ok end. + %%%================================================================= %%% Misceleaneous functions %%%================================================================= 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/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index fa4397b2f5..8d6c77c0ed 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -380,27 +380,30 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_BANNER), language = Lang }; +decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_REQUEST), ?UINT32(Len0), Name:Len0/binary, + ?UINT32(Len1), Inst:Len1/binary, ?UINT32(Len2), Lang:Len2/binary, + ?UINT32(NumPromtps), Data/binary>>) -> + #ssh_msg_userauth_info_request{ + name = Name, + instruction = Inst, + language_tag = Lang, + num_prompts = NumPromtps, + data = Data}; + +%%% Unhandled message, also masked by same 1:st byte value as ?SSH_MSG_USERAUTH_INFO_REQUEST: decode(<<?BYTE(?SSH_MSG_USERAUTH_PK_OK), ?UINT32(Len), Alg:Len/binary, KeyBlob/binary>>) -> #ssh_msg_userauth_pk_ok{ algorithm_name = Alg, key_blob = KeyBlob }; +%%% Unhandled message, also masked by same 1:st byte value as ?SSH_MSG_USERAUTH_INFO_REQUEST: decode(<<?BYTE(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?UINT32(Len0), Prompt:Len0/binary, ?UINT32(Len1), Lang:Len1/binary>>) -> #ssh_msg_userauth_passwd_changereq{ prompt = Prompt, languge = Lang }; -decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_REQUEST), ?UINT32(Len0), Name:Len0/binary, - ?UINT32(Len1), Inst:Len1/binary, ?UINT32(Len2), Lang:Len2/binary, - ?UINT32(NumPromtps), Data/binary>>) -> - #ssh_msg_userauth_info_request{ - name = Name, - instruction = Inst, - language_tag = Lang, - num_prompts = NumPromtps, - data = Data}; decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?UINT32(Num), Data/binary>>) -> #ssh_msg_userauth_info_response{ @@ -424,8 +427,9 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST_OLD), ?UINT32(N)>>) -> #ssh_msg_kex_dh_gex_request_old{ n = N }; -decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), ?UINT32(Len0), Prime:Len0/big-signed-integer, - ?UINT32(Len1), Generator:Len1/big-signed-integer>>) -> +decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), + ?UINT32(Len0), Prime:Len0/big-signed-integer-unit:8, + ?UINT32(Len1), Generator:Len1/big-signed-integer-unit:8>>) -> #ssh_msg_kex_dh_gex_group{ p = Prime, g = Generator 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/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 0033010dce..a2b4663219 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -73,7 +73,7 @@ to_atom(Str) -> error end. -match(Prefix, Alts, Extra) -> +match(Prefix, Alts, Extra0) -> Len = length(Prefix), Matches = lists:sort( [{S, A} || {H, A} <- Alts, @@ -89,13 +89,11 @@ match(Prefix, Alts, Extra) -> {yes, Remain, []} end; {complete, Str} -> - {_, Arity} = lists:keyfind(Str, 1, Matches), - case {Arity, Extra} of - {0, "("} -> - {yes, nthtail(Len, Str) ++ "()", []}; - _ -> - {yes, nthtail(Len, Str) ++ Extra, []} - end; + Extra = case {Extra0,Matches} of + {"(",[{Str,0}]} -> "()"; + {_,_} -> Extra0 + end, + {yes, nthtail(Len, Str) ++ Extra, []}; no -> {no, [], []} end. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 5f96795d92..63e7be4b74 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -241,23 +241,15 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); %% map -expr({map_field_assoc,_,EK, EV}, Bs0, Lf, Ef, RBs) -> - {value,K,Bs1} = expr(EK, Bs0, Lf, Ef, none), - {value,V,Bs2} = expr(EV, Bs0, Lf, Ef, none), - ret_expr({map_assoc,K,V}, merge_bindings(Bs1,Bs2), RBs); -expr({map_field_exact,_,EK, EV}, Bs0, Lf, Ef, RBs) -> - {value,K,Bs1} = expr(EK, Bs0, Lf, Ef, none), - {value,V,Bs2} = expr(EV, Bs0, Lf, Ef, none), - ret_expr({map_exact,K,V}, merge_bindings(Bs1,Bs2), RBs); expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) -> {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs), - {Vs,Bs} = expr_list(Es, Bs1, Lf, Ef), + {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef), ret_expr(lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, Map0, Vs), Bs, RBs); expr({map,_,Es}, Bs0, Lf, Ef, RBs) -> - {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), + {Vs,Bs} = eval_map_fields(Es, Bs0, Lf, Ef), ret_expr(lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, maps:new(), Vs), Bs, RBs); @@ -749,6 +741,24 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> end end. +%% eval_map_fields([Field], Bindings, LocalFunctionHandler, +%% ExternalFuncHandler) -> +%% {[{map_assoc | map_exact,Key,Value}],Bindings} + +eval_map_fields(Fs, Bs, Lf, Ef) -> + eval_map_fields(Fs, Bs, Lf, Ef, []). + +eval_map_fields([{map_field_assoc,_,K0,V0}|Fs], Bs0, Lf, Ef, Acc) -> + {value,K1,Bs1} = expr(K0, Bs0, Lf, Ef, none), + {value,V1,Bs2} = expr(V0, Bs1, Lf, Ef, none), + eval_map_fields(Fs, Bs2, Lf, Ef, [{map_assoc,K1,V1}|Acc]); +eval_map_fields([{map_field_exact,_,K0,V0}|Fs], Bs0, Lf, Ef, Acc) -> + {value,K1,Bs1} = expr(K0, Bs0, Lf, Ef, none), + {value,V1,Bs2} = expr(V0, Bs1, Lf, Ef, none), + eval_map_fields(Fs, Bs2, Lf, Ef, [{map_exact,K1,V1}|Acc]); +eval_map_fields([], Bs, _Lf, _Ef, Acc) -> + {lists:reverse(Acc),Bs}. + %% RBs is the bindings to return when the evalution of a function %% (fun) has finished. If RBs =:= none, then the evalution took place 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/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 8a1d8e0440..9dbe89da91 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -479,6 +479,15 @@ lexpr({record_field, _, Rec, F}, Prec, Opts) -> {L,P,R} = inop_prec('.'), El = [lexpr(Rec, L, Opts),$.,lexpr(F, R, Opts)], maybe_paren(P, Prec, El); +lexpr({map, _, Fs}, Prec, Opts) -> + {P,_R} = preop_prec('#'), + El = {first,leaf("#"),map_fields(Fs, Opts)}, + maybe_paren(P, Prec, El); +lexpr({map, _, Map, Fs}, Prec, Opts) -> + {L,P,_R} = inop_prec('#'), + Rl = lexpr(Map, L, Opts), + El = {first,[Rl,leaf("#")],map_fields(Fs, Opts)}, + maybe_paren(P, Prec, El); lexpr({block,_,Es}, _, Opts) -> {list,[{step,'begin',body(Es, Opts)},'end']}; lexpr({'if',_,Cs}, _, Opts) -> @@ -671,6 +680,16 @@ record_field({typed_record_field,Field,Type}, Opts) -> record_field({record_field,_,F}, Opts) -> lexpr(F, 0, Opts). +map_fields(Fs, Opts) -> + tuple(Fs, fun map_field/2, Opts). + +map_field({map_field_assoc,_,K,V}, Opts) -> + Pl = lexpr(K, 0, Opts), + {list,[{step,[Pl,leaf(" =>")],lexpr(V, 0, Opts)}]}; +map_field({map_field_exact,_,K,V}, Opts) -> + Pl = lexpr(K, 0, Opts), + {list,[{step,[Pl,leaf(" :=")],lexpr(V, 0, Opts)}]}. + list({cons,_,H,T}, Es, Opts) -> list(T, [H|Es], Opts); list({nil,_}, Es, Opts) -> diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index afc63496d0..7f3cd8f592 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. 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 @@ -19,7 +19,6 @@ -module(re). -export([grun/3,urun/3,ucompile/2,replace/3,replace/4,split/2,split/3]). -%-opaque mp() :: {re_pattern, _, _, _, _}. -type mp() :: {re_pattern, _, _, _, _}. -type nl_spec() :: cr | crlf | lf | anycrlf | any. 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/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 2c1c5acf5a..43c980e994 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -26,11 +26,11 @@ -include_lib("test_server/include/test_server.hrl"). -% Default timetrap timeout (set in init_per_testcase). +%% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> - ?line Dog = ?t:timetrap(?default_timeout), + Dog = ?t:timetrap(?default_timeout), [{watchdog, Dog} | Config]. end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), @@ -67,23 +67,21 @@ normal(doc) -> normal(suite) -> []; normal(Config) when is_list(Config) -> - ?line {module,expand_test} = c:l(expand_test), - % These tests might fail if another module with the prefix "expand_" happens - % to also be loaded. - ?line {yes, "test:", []} = edlin_expand:expand(lists:reverse("expand_")), - ?line {no, [], []} = edlin_expand:expand(lists:reverse("expandXX_")), - ?line {no,[], - [{"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"expand0arity_entirely",0}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand(lists:reverse("expand_test:")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("expand_test:a_")), - ?line {yes,"arity_entirely()",[]} = edlin_expand:expand( - lists:reverse("expand_test:expand0")), + {module,expand_test} = c:l(expand_test), + %% These tests might fail if another module with the prefix + %% "expand_" happens to also be loaded. + {yes, "test:", []} = do_expand("expand_"), + {no, [], []} = do_expand("expandXX_"), + {no,[], + [{"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"expand0arity_entirely",0}, + {"module_info",0}, + {"module_info",1}]} = do_expand("expand_test:"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("expand_test:a_"), + {yes,"arity_entirely()",[]} = do_expand("expand_test:expand0"), ok. quoted_fun(doc) -> @@ -91,38 +89,35 @@ quoted_fun(doc) -> quoted_fun(suite) -> []; quoted_fun(Config) when is_list(Config) -> - ?line {module,expand_test} = c:l(expand_test), - ?line {module,expand_test1} = c:l(expand_test1), + {module,expand_test} = c:l(expand_test), + {module,expand_test1} = c:l(expand_test1), %% should be no colon after test this time - ?line {yes, "test", []} = edlin_expand:expand(lists:reverse("expand_")), - ?line {no, [], []} = edlin_expand:expand(lists:reverse("expandXX_")), - ?line {no,[],[{"'#weird-fun-name'",1}, - {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}, - {"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand( - lists:reverse("expand_test1:")), - ?line {yes,"_",[]} = edlin_expand:expand( - lists:reverse("expand_test1:a")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("expand_test1:a_")), - ?line {yes,[], - [{"'#weird-fun-name'",1}, + {yes, "test", []} = do_expand("expand_"), + {no, [], []} = do_expand("expandXX_"), + {no,[],[{"'#weird-fun-name'",1}, {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("expand_test1:'")), - ?line {yes,"uoted_fun_",[]} = edlin_expand:expand( - lists:reverse("expand_test1:'Q")), - ?line {yes,[], - [{"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("expand_test1:'Quoted_fun_")), - ?line {yes,"weird-fun-name'(",[]} = edlin_expand:expand( - lists:reverse("expand_test1:'#")), + {"'Quoted_fun_too'",0}, + {"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("expand_test1:"), + {yes,"_",[]} = do_expand("expand_test1:a"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("expand_test1:a_"), + {yes,[], + [{"'#weird-fun-name'",1}, + {"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("expand_test1:'"), + {yes,"uoted_fun_",[]} = do_expand("expand_test1:'Q"), + {yes,[], + [{"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("expand_test1:'Quoted_fun_"), + {yes,"weird-fun-name'(",[]} = do_expand("expand_test1:'#"), + + %% Since there is a module_info/1 as well as a module_info/0 + %% there should not be a closing parenthesis added. + {yes,"(",[]} = do_expand("expand_test:module_info"), ok. quoted_module(doc) -> @@ -130,51 +125,46 @@ quoted_module(doc) -> quoted_module(suite) -> []; quoted_module(Config) when is_list(Config) -> - ?line {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), - ?line {yes, "Caps':", []} = edlin_expand:expand(lists:reverse("'ExpandTest")), - ?line {no,[], - [{"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand(lists:reverse("'ExpandTestCaps':")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps':a_")), + {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), + {yes, "Caps':", []} = do_expand("'ExpandTest"), + {no,[], + [{"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("'ExpandTestCaps':"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("'ExpandTestCaps':a_"), ok. quoted_both(suite) -> []; quoted_both(Config) when is_list(Config) -> - ?line {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), - ?line {module,'ExpandTestCaps1'} = c:l('ExpandTestCaps1'), + {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), + {module,'ExpandTestCaps1'} = c:l('ExpandTestCaps1'), %% should be no colon (or quote) after test this time - ?line {yes, "Caps", []} = edlin_expand:expand(lists:reverse("'ExpandTest")), - ?line {no,[],[{"'#weird-fun-name'",0}, - {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}, - {"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':")), - ?line {yes,"_",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':a")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':a_")), - ?line {yes,[], - [{"'#weird-fun-name'",0}, + {yes, "Caps", []} = do_expand("'ExpandTest"), + {no,[],[{"'#weird-fun-name'",0}, {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'")), - ?line {yes,"uoted_fun_",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'Q")), - ?line {yes,[], - [{"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'Quoted_fun_")), - ?line {yes,"weird-fun-name'()",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'#")), + {"'Quoted_fun_too'",0}, + {"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("'ExpandTestCaps1':"), + {yes,"_",[]} = do_expand("'ExpandTestCaps1':a"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("'ExpandTestCaps1':a_"), + {yes,[], + [{"'#weird-fun-name'",0}, + {"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("'ExpandTestCaps1':'"), + {yes,"uoted_fun_",[]} = do_expand("'ExpandTestCaps1':'Q"), + {yes,[], + [{"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("'ExpandTestCaps1':'Quoted_fun_"), + {yes,"weird-fun-name'()",[]} = do_expand("'ExpandTestCaps1':'#"), ok. + +do_expand(String) -> + edlin_expand:expand(lists:reverse(String)). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c4b6b35e72..b194c7cb41 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -42,7 +42,8 @@ try_catch/1, eval_expr_5/1, zero_width/1, - eep37/1]). + eep37/1, + eep43/1]). %% %% Define to run outside of test server @@ -82,7 +83,7 @@ all() -> simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width, - eep37]. + eep37, eep43]. groups() -> []. @@ -1424,6 +1425,20 @@ eep37(Config) when is_list(Config) -> 720), ok. +eep43(Config) when is_list(Config) -> + check(fun () -> #{} end, " #{}.", #{}), + check(fun () -> #{a => b} end, "#{a => b}.", #{a => b}), + check(fun () -> + Map = #{a => b}, + {Map#{a := b},Map#{a => c},Map#{d => e}} + end, + "begin " + " Map = #{a => B=b}, " + " {Map#{a := B},Map#{a => c},Map#{d => e}} " + "end.", + {#{a => b},#{a => c},#{a => b,d => e}}), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), 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/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index cc744ee76b..390322a5fa 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -46,6 +46,7 @@ import_export/1, misc_attrs/1, dialyzer_attrs/1, hook/1, neg_indent/1, + maps_syntax/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, @@ -76,7 +77,8 @@ groups() -> [{expr, [], [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, - messages, old_mnemosyne_syntax]}, + messages, old_mnemosyne_syntax, maps_syntax + ]}, {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, @@ -975,6 +977,25 @@ count_atom(L, A) when is_list(L) -> count_atom(_, _) -> 0. +maps_syntax(doc) -> "Maps syntax"; +maps_syntax(suite) -> []; +maps_syntax(Config) when is_list(Config) -> + Ts = [{map_fun_1, + <<"t() ->\n" + " M0 = #{ 1 => hi, hi => 42, 1.0 => {hi,world}},\n" + " M1 = M0#{ 1 := hello, new_val => 1337 },\n" + " map_fun_2:val(M1).\n">>}, + {map_fun_2, + <<"val(#{ 1 := V1, hi := V2, new_val := V3}) -> {V1,V2,V3}.\n">>}], + compile(Config, Ts), + + ok = pp_expr(<<"#{}">>), + ok = pp_expr(<<"#{ a => 1, <<\"hi\">> => \"world\", 33 => 1.0 }">>), + ok = pp_expr(<<"#{ a := V1, <<\"hi\">> := V2 } = M">>), + ok = pp_expr(<<"M#{ a => V1, <<\"hi\">> := V2 }">>), + ok. + + otp_8567(doc) -> "OTP_8567. Avoid duplicated 'undefined' in record field types."; otp_8567(suite) -> []; 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.erl b/lib/test_server/src/test_server.erl index bc83739ba6..d367e7b5d6 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -176,8 +176,6 @@ module_names(Beams) -> do_cover_compile(Modules) -> do_cover_compile1(lists:usort(Modules)). % remove duplicates -do_cover_compile1([Dont|Rest]) when Dont=:=cover -> - do_cover_compile1(Rest); do_cover_compile1([M|Rest]) -> case {code:is_sticky(M),code:is_loaded(M)} of {true,_} -> 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" diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index d26b8adfcd..a24d70ed92 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -89,8 +89,9 @@ flush/1, stop/0, stop/1]). -export([remote_start/1,get_main_node/0]). -%-export([bump/5]). --export([transform/4]). % for test purposes + +%% Used internally to ensure we upgrade the code to the latest version. +-export([main_process_loop/1,remote_process_loop/1]). -record(main_state, {compiled=[], % [{Module,File}] imported=[], % [{Module,File,ImportFile}] @@ -110,7 +111,6 @@ -define(BUMP_REC_NAME,bump). -record(vars, {module, % atom() Module name - vsn, % atom() init_info=[], % [{M,F,A,C,L}] @@ -230,25 +230,9 @@ compile_directory(Dir) when is_list(Dir) -> compile_directory(Dir, Options) when is_list(Dir), is_list(Options) -> case file:list_dir(Dir) of {ok, Files} -> - - %% Filter out all erl files (except cover.erl) - ErlFileNames = - lists:filter(fun("cover.erl") -> - false; - (File) -> - case filename:extension(File) of - ".erl" -> true; - _ -> false - end - end, - Files), - - %% Create a list of .erl file names (incl path) and call - %% compile_modules/2 with the list of file names. - ErlFiles = lists:map(fun(ErlFileName) -> - filename:join(Dir, ErlFileName) - end, - ErlFileNames), + ErlFiles = [filename:join(Dir, File) || + File <- Files, + filename:extension(File) =:= ".erl"], compile_modules(ErlFiles, Options); Error -> Error @@ -262,7 +246,7 @@ compile_modules([File|Files], Options, Result) -> R = call({compile, File, Options}), compile_modules(Files,Options,[R|Result]); compile_modules([],_Opts,Result) -> - reverse(Result). + lists:reverse(Result). filter_options(Options) -> lists:filter(fun(Option) -> @@ -320,25 +304,9 @@ compile_beam_directory() -> compile_beam_directory(Dir) when is_list(Dir) -> case file:list_dir(Dir) of {ok, Files} -> - - %% Filter out all beam files (except cover.beam) - BeamFileNames = - lists:filter(fun("cover.beam") -> - false; - (File) -> - case filename:extension(File) of - ".beam" -> true; - _ -> false - end - end, - Files), - - %% Create a list of .beam file names (incl path) and call - %% compile_beam/1 for each such file name - BeamFiles = lists:map(fun(BeamFileName) -> - filename:join(Dir, BeamFileName) - end, - BeamFileNames), + BeamFiles = [filename:join(Dir, File) || + File <- Files, + filename:extension(File) =:= ".beam"], compile_beams(BeamFiles); Error -> Error @@ -350,7 +318,7 @@ compile_beams([File|Files],Result) -> R = compile_beam(File), compile_beams(Files,[R|Result]); compile_beams([],Result) -> - reverse(Result). + lists:reverse(Result). %% analyse(Module) -> @@ -613,8 +581,11 @@ main_process_loop(State) -> Compiled = add_compiled(Module, File, State#main_state.compiled), Imported = remove_imported(Module,State#main_state.imported), - main_process_loop(State#main_state{compiled = Compiled, - imported = Imported}); + NewState = State#main_state{compiled = Compiled, + imported = Imported}, + %% This module (cover) could have been reloaded. Make + %% sure we run the new code. + ?MODULE:main_process_loop(NewState); error -> reply(From, {error, File}), main_process_loop(State) @@ -639,8 +610,11 @@ main_process_loop(State) -> end, reply(From,Reply), Imported = remove_imported(Module,State#main_state.imported), - main_process_loop(State#main_state{compiled = Compiled, - imported = Imported}); + NewState = State#main_state{compiled = Compiled, + imported = Imported}, + %% This module (cover) could have been reloaded. Make + %% sure we run the new code. + ?MODULE:main_process_loop(NewState); {error,no_beam} -> %% The module has first been compiled from .erl, and now %% someone tries to compile it from .beam @@ -857,7 +831,7 @@ remote_process_loop(State) -> {remote,load_compiled,Compiled} -> Compiled1 = load_compiled(Compiled,State#remote_state.compiled), remote_reply(State#remote_state.main_node, ok), - remote_process_loop(State#remote_state{compiled=Compiled1}); + ?MODULE:remote_process_loop(State#remote_state{compiled=Compiled1}); {remote,unload,UnloadedModules} -> unload(UnloadedModules), @@ -1257,12 +1231,12 @@ add_imported(M, F1, ImportFile, [{M,_F2,ImportFiles}|Imported], Acc) -> dont_import; false -> NewEntry = {M, F1, [ImportFile | ImportFiles]}, - {ok, reverse([NewEntry | Acc]) ++ Imported} + {ok, lists:reverse([NewEntry | Acc]) ++ Imported} end; add_imported(M, F, ImportFile, [H|Imported], Acc) -> add_imported(M, F, ImportFile, Imported, [H|Acc]); add_imported(M, F, ImportFile, [], Acc) -> - {ok, reverse([{M, F, [ImportFile]} | Acc])}. + {ok, lists:reverse([{M, F, [ImportFile]} | Acc])}. %% Removes a module from the list of imported modules and writes a warning %% This is done when a module is compiled. @@ -1383,9 +1357,9 @@ do_compile_beam(Module,Beam,UserOptions) -> {error,E}; encrypted_abstract_code=E -> {error,E}; - {Vsn,Code} -> + {raw_abstract_v1,Code} -> Forms0 = epp:interpret_file_attribute(Code), - {Forms,Vars} = transform(Vsn, Forms0, Module, Beam), + {Forms,Vars} = transform(Forms0, Module), %% We need to recover the source from the compilation %% info otherwise the newly compiled module will have @@ -1400,7 +1374,7 @@ do_compile_beam(Module,Beam,UserOptions) -> {module, Module} -> %% Store info about all function clauses in database - InitInfo = reverse(Vars#vars.init_info), + InitInfo = lists:reverse(Vars#vars.init_info), ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), %% Store binary code so it can be loaded on remote nodes @@ -1411,7 +1385,11 @@ do_compile_beam(Module,Beam,UserOptions) -> _Error -> do_clear(Module), error - end + end; + {_VSN,_Code} -> + %% Wrong version of abstract code. Just report that there + %% is no abstract code. + {error,no_abstract_code} end. get_abstract_code(Module, Beam) -> @@ -1445,28 +1423,9 @@ get_compile_info(Module, Beam) -> [] end. -transform(Vsn, Code, Module, Beam) when Vsn=:=abstract_v1; Vsn=:=abstract_v2 -> - Vars0 = #vars{module=Module, vsn=Vsn}, - MainFile=find_main_filename(Code), - {ok, MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), - - %% Add module and export information to the munged forms - %% Information about module_info must be removed as this function - %% is added at compilation - {ok, {Module, [{exports,Exports1}]}} = beam_lib:chunks(Beam, [exports]), - Exports2 = lists:filter(fun(Export) -> - case Export of - {module_info,_} -> false; - _ -> true - end - end, - Exports1), - Forms = [{attribute,1,module,Module}, - {attribute,2,export,Exports2}]++ MungedForms, - {Forms,Vars}; -transform(Vsn=raw_abstract_v1, Code, Module, _Beam) -> +transform(Code, Module) -> MainFile=find_main_filename(Code), - Vars0 = #vars{module=Module, vsn=Vsn}, + Vars0 = #vars{module=Module}, {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), {MungedForms,Vars}. @@ -1486,7 +1445,7 @@ transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) -> transform_2(Forms,[MungedForm|MungedForms],Vars2,MainFile,NewSwitch) end; transform_2([],MungedForms,Vars,_,_) -> - {ok, reverse(MungedForms), Vars}. + {ok, lists:reverse(MungedForms), Vars}. %% Expand short-circuit Boolean expressions. expand(Expr) -> @@ -1553,14 +1512,9 @@ aux_var(Vars, N) -> end. %% This code traverses the abstract code, stored as the abstract_code -%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B -%% (Vsn=abstract_v2). -%% The abstract format after preprocessing differs slightly from the abstract -%% format given eg using epp:parse_form, this has been noted in comments. -%% The switch is turned off when we encounter other files then the main file. +%% chunk in the BEAM file, as described in absform(3). +%% The switch is turned off when we encounter other files than the main file. %% This way we will be able to exclude functions defined in include files. -munge({function,0,module_info,_Arity,_Clauses},_Vars,_MainFile,_Switch) -> - ignore; % module_info will be added again when the forms are recompiled munge({function,Line,Function,Arity,Clauses},Vars,_MainFile,on) -> Vars2 = Vars#vars{function=Function, arity=Arity, @@ -1618,7 +1572,7 @@ munge_clauses([Clause|Clauses], Vars, Lines, MClauses) -> MClauses]) end; munge_clauses([], Vars, Lines, MungedClauses) -> - {reverse(MungedClauses), Vars#vars{lines = Lines}}. + {lists:reverse(MungedClauses), Vars#vars{lines = Lines}}. munge_body(Expr, Vars) -> munge_body(Expr, Vars, [], []). @@ -1662,7 +1616,7 @@ munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) -> munge_body(Body, Vars3, MungedExprs1, NewBumps) end; munge_body([], Vars, MungedBody, _LastExprBumpLines) -> - {reverse(MungedBody), Vars}. + {lists:reverse(MungedBody), Vars}. %%% Fix last expression (OTP-8188). A typical example: %%% @@ -1801,16 +1755,13 @@ munge_expr({tuple,Line,Exprs}, Vars) -> {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), {{tuple,Line,MungedExprs}, Vars2}; munge_expr({record,Line,Name,Exprs}, Vars) -> - %% Only for Vsn=raw_abstract_v1 {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,MungedArg,Name,MungedExprFields}, Vars3}; munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> - %% Only for Vsn=raw_abstract_v1 {MungedExprR, Vars2} = munge_expr(ExprR, Vars), {{record_field,Line,ExprL,MungedExprR}, Vars2}; munge_expr({cons,Line,ExprH,ExprT}, Vars) -> @@ -1874,23 +1825,10 @@ munge_expr({'try',Line,Body,Clauses,CatchClauses,After}, Vars) -> {MungedAfter, Vars4} = munge_body(After, Vars3), {{'try',Line,MungedBody,MungedClauses,MungedCatchClauses,MungedAfter}, Vars4}; -%% Difference in abstract format after preprocessing: Funs get an extra -%% element Extra. -%% NOT NECESSARY FOR Vsn=raw_abstract_v1 -munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> - {{'fun',Line,{function,Name,Arity}}, Vars}; -munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> - %% Only for Vsn=raw_abstract_v1 {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({named_fun,Line,Name,Clauses,_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), - {{named_fun,Line,Name,MungedClauses}, Vars2}; munge_expr({named_fun,Line,Name,Clauses}, Vars) -> - %% Only for Vsn=raw_abstract_v1 {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), {{named_fun,Line,Name,MungedClauses}, Vars2}; munge_expr({bin,Line,BinElements}, Vars) -> @@ -1911,7 +1849,7 @@ munge_exprs([Expr|Exprs], Vars, MungedExprs) -> {MungedExpr, Vars2} = munge_expr(Expr, Vars), munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); munge_exprs([], Vars, MungedExprs) -> - {reverse(MungedExprs), Vars}. + {lists:reverse(MungedExprs), Vars}. %% Every qualifier is decorated with a counter. munge_qualifiers(Qualifiers, Vars) -> @@ -1930,7 +1868,7 @@ munge_qs([Expr|Qs], Vars, MQs) -> {MungedExpr, Vars2} = munge_expr(Expr, Vars), munge_qs1(Qs, L, MungedExpr, Vars, Vars2, MQs); munge_qs([], Vars, MQs) -> - {reverse(MQs), Vars}. + {lists:reverse(MQs), Vars}. munge_qs1(Qs, Line, NQ, Vars, Vars2, MQs) -> case new_bumps(Vars2, Vars) of @@ -2123,7 +2061,7 @@ merge_clauses([{{M,F,A,_C1},R1},{{M,F,A,C2},R2}|Clauses], MFun, Result) -> merge_clauses([{{M,F,A,_C},R}|Clauses], MFun, Result) -> merge_clauses(Clauses, MFun, [{{M,F,A},R}|Result]); merge_clauses([], _Fun, Result) -> - reverse(Result). + lists:reverse(Result). merge_functions([{_MFA,R}|Functions], MFun) -> merge_functions(Functions, MFun, R); @@ -2444,14 +2382,6 @@ not_loaded(_Module,_Else, State) -> %%%--Div----------------------------------------------------------------- -reverse(List) -> - reverse(List,[]). -reverse([H|T],Acc) -> - reverse(T,[H|Acc]); -reverse([],Acc) -> - Acc. - - escape_lt_and_gt(Rawline,HTML) when HTML =/= true -> Rawline; escape_lt_and_gt(Rawline,_HTML) -> diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index bd71218474..ec61c57cec 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -22,7 +22,8 @@ suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([start/1, compile/1, analyse/1, misc/1, stop/1, +-export([coverage/1, coverage_analysis/1, + start/1, compile/1, analyse/1, misc/1, stop/1, distribution/1, reconnect/1, die_and_reconnect/1, dont_reconnect_after_stop/1, stop_node_after_disconnect/1, export_import/1, @@ -30,6 +31,8 @@ otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, otp_10979_hanging_node/1, compile_beam_opts/1, eep37/1]). +-export([do_coverage/1]). + -include_lib("test_server/include/test_server.hrl"). %%---------------------------------------------------------------------- @@ -46,25 +49,25 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> + NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, + otp_8340,otp_8188,compile_beam_opts,eep37], + StartStop = [start, compile, analyse, misc, stop, + distribution, reconnect, die_and_reconnect, + dont_reconnect_after_stop, stop_node_after_disconnect, + export_import, otp_5031, otp_6115, + otp_8270, otp_10979_hanging_node], case whereis(cover_server) of undefined -> - [start, compile, analyse, misc, stop, - distribution, reconnect, die_and_reconnect, - dont_reconnect_after_stop, stop_node_after_disconnect, - export_import, otp_5031, eif, otp_5305, otp_5418, - otp_6115, otp_7095, otp_8188, otp_8270, otp_8273, - otp_8340, otp_10979_hanging_node, compile_beam_opts, eep37]; + [coverage,StartStop ++ NoStartStop]; _pid -> - {skip, - "It looks like the test server is running " - "cover. Can't run cover test."} + [coverage|NoStartStop++[coverage_analysis]] end. groups() -> []. init_per_suite(Config) -> - Config. + [{ct_is_running_cover,whereis(cover_server) =/= undefined}|Config]. end_per_suite(_Config) -> ok. @@ -90,13 +93,64 @@ init_per_testcase(TC, Config) when TC =:= misc; init_per_testcase(_TestCase, Config) -> Config. -end_per_testcase(TestCase, _Config) -> - case lists:member(TestCase,[start,compile,analyse,misc]) of +end_per_testcase(TestCase, Config) -> + NoStop = [start,compile,analyse,misc], + DontStop = proplists:get_bool(ct_is_running_cover, Config) orelse + lists:member(TestCase, NoStop), + case DontStop of true -> ok; false -> cover:stop() end, ok. +coverage(Config) when is_list(Config) -> + {ok,?MODULE} = cover:compile_beam(?MODULE), + ?MODULE:do_coverage(Config). + +do_coverage(Config) -> + Outdir = ?config(priv_dir, Config), + ExportFile = filename:join(Outdir, "export"), + ok = cover:export(ExportFile, ?MODULE), + {error,{already_started,_}} = cover:start(), + {error,_} = cover:compile_beam(non_existing_module), + _ = cover:which_nodes(), + _ = cover:modules(), + _ = cover:imported(), + {error,{not_cover_compiled,lists}} = cover:analyze(lists), + + %% Cover escaping of '&' in HTML files. + + case proplists:get_bool(ct_is_running_cover, Config) of + false -> + %% Cover server was implicitly started when this module + %% was cover-compiled. We must stop the cover server, but + %% we must ensure that this module is not on the call + %% stack when it is unloaded. Therefore, the call that + %% follows MUST be tail-recursive. + cover:stop(); + true -> + %% Cover server was started by common_test; don't stop it. + ok + end. + +%% This test case will only be run when common_test is running cover. +coverage_analysis(Config) when is_list(Config) -> + {ok,Analysis1} = cover:analyze(?MODULE), + io:format("~p\n", [Analysis1]), + {ok,Analysis2} = cover:analyze(?MODULE, calls), + io:format("~p\n", [Analysis2]), + {ok,_Analysis3} = cover:analyze(?MODULE, calls, line), + + Outdir = ?config(priv_dir, Config), + Outfile = filename:join(Outdir, ?MODULE), + + {ok,Outfile} = cover:analyze_to_file(?MODULE, Outfile), + {ok,Contents} = file:read_file(Outfile), + ok = file:delete(Outfile), + ok = io:put_chars(Contents), + {ok,Outfile} = cover:analyze_to_file(?MODULE, Outfile, [html]), + ok. + start(suite) -> []; start(Config) when is_list(Config) -> ?line ok = file:set_cwd(?config(data_dir, Config)), @@ -759,7 +813,6 @@ eif(Config) when is_list(Config) -> %% in cover_inc.beam - not the ones from the included file. ?line cover_inc:func(), ?line {ok, [_, _]} = cover:analyse(cover_inc, line), - ?line cover:stop(), ok. otp_5305(suite) -> []; @@ -775,7 +828,6 @@ otp_5305(Config) when is_list(Config) -> ">>, ?line ok = file:write_file(File, Test), ?line {ok, t} = cover:compile(File), - ?line cover:stop(), ?line ok = file:delete(File), ok. @@ -790,7 +842,6 @@ otp_5418(Config) when is_list(Config) -> ?line ok = file:write_file(File, Test), ?line {ok, t} = cover:compile(File), ?line {ok,{t,{0,0}}} = cover:analyse(t, module), - ?line cover:stop(), ?line ok = file:delete(File), ok. @@ -952,7 +1003,6 @@ otp_7095(Config) when is_list(Config) -> {{t,67},1},{{t,69},1},{{t,71},1},{{t,74},1}, {{t,76},0},{{t,78},1}, {{t,82},2}]} = cover:analyse(t, calls, line), - ?line cover:stop(), ?line ok = file:delete(File), ok. @@ -1028,7 +1078,6 @@ otp_8273(Config) when is_list(Config) -> ">>, ?line File = cc_mod(t, Test, Config), ?line ok = t:t(), - ?line cover:stop(), ?line ok = file:delete(File), ok. @@ -1066,7 +1115,6 @@ otp_8188(Config) when is_list(Config) -> ?line File = cc_mod(t, Test, Config), ?line false = t:test(nok), ?line {ok,[{{t,11},1},{{t,12},1}]} = cover:analyse(t, calls, line), - ?line cover:stop(), ?line ok = file:delete(File), %% Bit string comprehensions are now traversed; @@ -1433,6 +1481,8 @@ compile_beam_opts(Config) when is_list(Config) -> export_all, debug_info, return_errors]), + code:purge(t), + code:delete(t), Exports = [{func1,0}, {macro, 0}, @@ -1443,7 +1493,6 @@ compile_beam_opts(Config) when is_list(Config) -> Exports = t:module_info(exports), {ok, t} = cover:compile_beam("t"), Exports = t:module_info(exports), - cover:stop(), ok = file:delete("t.beam"), ok = file:set_cwd(Cwd), ok. diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 26685a6a84..1227d5b841 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -127,6 +127,14 @@ basic(Config) when is_list(Config) -> ok. basic_option(Config) when is_list(Config) -> + %% Eprof is not supported on native-compile code. + case lists:module_info(native_addresses) of + [] -> basic_option_1(Config); + [_|_] -> {skip,"lists is native-compiled"} + end. + +basic_option_1(Config) -> + %% load eprof_test and change directory {ok, OldCurDir} = file:get_cwd(), diff --git a/lib/wx/api_gen/Makefile b/lib/wx/api_gen/Makefile index 8adb485ba9..3e41ac7bc5 100644 --- a/lib/wx/api_gen/Makefile +++ b/lib/wx/api_gen/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2012. 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 @@ -60,7 +60,7 @@ $(GL): glxml_generated $(GL_COMP_T) glapi.conf erl -noshell -run gl_gen code && touch gl_code_generated %.beam: %.erl wx_gen.hrl gl_gen.hrl - $(ERLC) -W $(ERL_FLAGS) $(ERL_COMPILE_FLAGS) $< -o$(EBIN) + $(ERLC) -W $(ERL_FLAGS) $(ERL_COMPILE_FLAGS) -o$(EBIN) $< # TODO split cleans into separate targets? complete_clean: diff --git a/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src b/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src index 9c5f46b253..5d20019d8f 100644 --- a/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src +++ b/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src @@ -1,17 +1,5 @@ -case 98: { // wxeEvtListener::wxeEvtListener - wxeEvtListener *Result = new wxeEvtListener(Ecmd.port); - rt.addRef(getRef((void *)Result,memenv), "wxeEvtListener"); - break; -} -case 99: { // wxeEvtListener::destroy - wxObject *This = (wxObject *) getPtr(bp,memenv); - rt.addAtom("ok"); - delete This; - break; -} -case 100: { // wxEvtHandler::Connect - wxeEvtListener *Listener = (wxeEvtListener *) getPtr(bp,memenv); bp += 4; +case 100: { // wxEvtHandler::Connect wxEvtHandler *This = (wxEvtHandler *) getPtr(bp, memenv); bp += 4; int * winid = (int *) bp; bp += 4; int * lastId = (int *) bp; bp += 4; @@ -22,20 +10,22 @@ case 100: { // wxEvtHandler::Connect int * eventTypeLen = (int *) bp; bp += 4; int * class_nameLen = (int *) bp; bp += 4; - if(*haveUserData) { + if(*haveUserData) { userData = new wxeErlTerm(Ecmd.bin[0]); } int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; char *class_name = bp; bp+= *class_nameLen; if(eventType > 0 ) { - wxeCallbackData * Evt_cb = new wxeCallbackData(Ecmd.caller,getRef(This, memenv), - class_name,*fun_cb, - *skip, userData, Listener); + wxeEvtListener * Evt_cb = new wxeEvtListener(Ecmd.caller,getRef(This, memenv), + class_name,*fun_cb, + *skip, userData, Ecmd.port); This->Connect((int) *winid,(int) *lastId,eventType, (wxObjectEventFunction)(wxEventFunction) &wxeEvtListener::forward, - Evt_cb, Listener); + Evt_cb, Evt_cb); rt.addAtom("ok"); + rt.addRef(getRef((void *)Evt_cb,memenv), "wxeEvtListener"); + rt.addTupleCount(2); } else { rt.addAtom("badarg"); rt.addAtom("event_type"); @@ -43,7 +33,7 @@ case 100: { // wxEvtHandler::Connect } break; } -case 101: { // wxEvtHandler::Disconnect +case 101: { // wxEvtHandler::Disconnect wxeEvtListener *Listener = (wxeEvtListener *) getPtr(bp,memenv); bp += 4; wxEvtHandler *This = (wxEvtHandler *) getPtr(bp, memenv); bp += 4; int * winid = (int *) bp; bp += 4; @@ -53,14 +43,14 @@ case 101: { // wxEvtHandler::Disconnect int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; if(eventType > 0) { bool Result = This->Disconnect((int) *winid,(int) *lastId,eventType, - (wxObjectEventFunction)(wxEventFunction) - &wxeEvtListener::forward, - NULL, Listener); + (wxObjectEventFunction)(wxEventFunction) + &wxeEvtListener::forward, + NULL, Listener); rt.addBool(Result); } else { rt.addAtom("badarg"); rt.addAtom("event_type"); - rt.addTupleCount(2); + rt.addTupleCount(2); } break; } diff --git a/lib/wx/api_gen/wx_extra/wxEvtHandler.erl b/lib/wx/api_gen/wx_extra/wxEvtHandler.erl index c5802af679..c9726fd475 100644 --- a/lib/wx/api_gen/wx_extra/wxEvtHandler.erl +++ b/lib/wx/api_gen/wx_extra/wxEvtHandler.erl @@ -27,15 +27,11 @@ -export([connect/2, connect/3, disconnect/1, disconnect/2, disconnect/3]). %% internal exports --export([connect_impl/3, disconnect_impl/2, disconnect_impl/3, - new_evt_listener/0, destroy_evt_listener/1, - get_callback/1, replace_fun_with_id/2]). +-export([connect_impl/2, disconnect_impl/2]). -export_type([wxEvtHandler/0, wx/0, event/0]). -type wxEvtHandler() :: wx:wx_object(). --record(evh, {et=null,id=?wxID_ANY,lastId=?wxID_ANY,skip=undefined,userdata=[],cb=0}). - %% @doc Equivalent to {@link connect/3. connect(This, EventType, [])} -spec connect(This::wxEvtHandler(), EventType::wxEventType()) -> ok. connect(This, EventType) -> @@ -130,54 +126,34 @@ disconnect(This=#wx_ref{type=ThisT,ref=_ThisRef}, EventType, Opts) -> %% @hidden -connect_impl(#wx_ref{type=wxeEvtListener,ref=EvtList}, - #wx_ref{type=ThisT,ref=ThisRef}, - #evh{id=Winid, lastId=LastId, et=EventType, - skip=Skip, userdata=Userdata, cb=FunID}) +connect_impl(#wx_ref{type=ThisT,ref=ThisRef}, + #evh{id=Winid, lastId=LastId, et=EventType, + skip=Skip, userdata=Userdata, cb=FunID}) when is_integer(FunID)-> EventTypeBin = list_to_binary([atom_to_list(EventType)|[0]]), ThisTypeBin = list_to_binary([atom_to_list(ThisT)|[0]]), UD = if Userdata =:= [] -> 0; - true -> + true -> wxe_util:send_bin(term_to_binary(Userdata)), 1 end, - wxe_util:call(100, <<EvtList:32/?UI,ThisRef:32/?UI, + wxe_util:call(100, <<ThisRef:32/?UI, Winid:32/?UI,LastId:32/?UI, (wxe_util:from_bool(Skip)):32/?UI, UD:32/?UI, FunID:32/?UI, (size(EventTypeBin)):32/?UI, - (size(ThisTypeBin)):32/?UI, + (size(ThisTypeBin)):32/?UI, %% Note no alignment EventTypeBin/binary,ThisTypeBin/binary>>). %% @hidden -disconnect_impl(Listener, Object) -> - disconnect_impl(Listener, Object, #evh{}). -%% @hidden -disconnect_impl(#wx_ref{type=wxeEvtListener,ref=EvtList}, - #wx_ref{type=_ThisT,ref=ThisRef}, - #evh{id=Winid, lastId=LastId, et=EventType}) -> +disconnect_impl(#wx_ref{type=_ThisT,ref=ThisRef}, + #evh{id=Winid, lastId=LastId, et=EventType, + handler=#wx_ref{type=wxeEvtListener,ref=EvtList}}) -> EventTypeBin = list_to_binary([atom_to_list(EventType)|[0]]), - wxe_util:call(101, <<EvtList:32/?UI, + wxe_util:call(101, <<EvtList:32/?UI, ThisRef:32/?UI,Winid:32/?UI,LastId:32/?UI, (size(EventTypeBin)):32/?UI, %% Note no alignment EventTypeBin/binary>>). - -%% @hidden -new_evt_listener() -> - wxe_util:call(98, <<>>). - -%% @hidden -destroy_evt_listener(#wx_ref{type=wxeEvtListener,ref=EvtList}) -> - wxe_util:call(99, <<EvtList:32/?UI>>). - -%% @hidden -get_callback(#evh{cb=Callback}) -> - Callback. - -%% @hidden -replace_fun_with_id(Evh, Id) -> - Evh#evh{cb=Id}. diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 5ac57e4929..ea5d89be72 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -1190,15 +1190,6 @@ find_id(OtherClass) -> encode_events(Evs) -> ?WTC("encode_events"), - w("void wxeEvtListener::forward(wxEvent& event)~n" - "{~n" - "#ifdef DEBUG~n" - " if(!sendevent(&event, port))~n" - " fprintf(stderr, \"Couldn't send event!\\r\\n\");~n" - "#else~n" - "sendevent(&event, port);~n" - "#endif~n" - "}~n~n"), w("int getRef(void* ptr, wxeMemEnv* memenv)~n" "{~n" " WxeApp * app = (WxeApp *) wxTheApp;~n" @@ -1209,7 +1200,7 @@ encode_events(Evs) -> " char * evClass = NULL;~n" " wxMBConvUTF32 UTFconverter;~n" " wxeEtype *Etype = etmap[event->GetEventType()];~n" - " wxeCallbackData *cb = (wxeCallbackData *)event->m_callbackUserData;~n" + " wxeEvtListener *cb = (wxeEvtListener *)event->m_callbackUserData;~n" " WxeApp * app = (WxeApp *) wxTheApp;~n" " wxeMemEnv *memenv = app->getMemEnv(port);~n" " if(!memenv) return 0;~n~n" diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl index c87187edc5..a4b03d3fd1 100644 --- a/lib/wx/api_gen/wx_gen_erl.erl +++ b/lib/wx/api_gen/wx_gen_erl.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 @@ -137,15 +137,27 @@ gen_class1(C=#class{name=Name,parent=Parent,methods=Ms,options=Opts}) -> w("%% inherited exports~n",[]), Done0 = ["Destroy", "New", "Create", "destroy", "new", "create"], Done = gb_sets:from_list(Done0 ++ [M|| #method{name=M} <- lists:append(Ms)]), - {_, InExported} = gen_inherited(Parents, Done, []), - w("-export([~s]).~n~n", [args(fun(EF) -> EF end, ",", - lists:usort(["parent_class/1"|InExported]), + {_, InExported0} = gen_inherited(Parents, Done, []), + InExported = lists:ukeysort(2, [{?MODULE,{"parent_class","1"},false}|InExported0]), + w("-export([~s]).~n~n", [args(fun({_M,{F,A},_Dep}) -> F ++ "/" ++ A end, ",", + InExported, 60)]), w("-export_type([~s/0]).~n", [Name]), case lists:filter(fun({_F,Depr}) -> Depr end, ExportList) of [] -> ok; Depr -> w("-deprecated([~s]).~n~n", [args(fun({EF,_}) -> EF end, ",", Depr, 60)]) end, + case lists:filter(fun({_,_,Depr}) -> Depr end, InExported) of + [] -> ok; + NoWDepr -> w("-compile([~s]).~n~n", + [args(fun({M,{F,A},_}) -> + DStr=io_lib:format("{nowarn_deprecated_function, {~s,~s,~s}}", + [M,F,A]), + lists:flatten(DStr) + end, ",", NoWDepr, 60)]) + end, + + w("%% @hidden~n", []), parents_check(Parents), w("-type ~s() :: wx:wx_object().~n", [Name]), @@ -375,7 +387,7 @@ gen_inherited([Parent|Ps], Done0, Exported0) -> {Done,Exported} = gen_inherited_ms(Ms, Class, Done0, gb_sets:empty(), Exported0), gen_inherited(Ps, gb_sets:union(Done,Done0), Exported). -gen_inherited_ms([[#method{name=Name,alias=A,params=Ps0,where=W,method_type=MT}|_]|R], +gen_inherited_ms([[M=#method{name=Name,alias=A,params=Ps0,where=W,method_type=MT}|_]|R], Class,Skip,Done, Exported) when W =/= merged_c -> case gb_sets:is_member(Name,Skip) of @@ -399,8 +411,10 @@ gen_inherited_ms([[#method{name=Name,alias=A,params=Ps0,where=W,method_type=MT}| _ when W =:= erl_no_opt -> 0; _ -> 1 end, - Export = erl_func_name(Name,A) ++ "/" ++ integer_to_list(length(Args) + OptLen), - gen_inherited_ms(R,Class,Skip, gb_sets:add(Name,Done), [Export|Exported]); + {_, Depr} = deprecated(M,ignore), + Export = {Class,{erl_func_name(Name,A),integer_to_list(length(Args) + OptLen)}, Depr}, + gen_inherited_ms(R,Class,Skip, gb_sets:add(Name,Done), + [Export|Exported]); _ -> gen_inherited_ms(R,Class, Skip, Done, Exported) end; diff --git a/lib/wx/c_src/gen/wxe_events.cpp b/lib/wx/c_src/gen/wxe_events.cpp index a1b4d090b3..1bd17366a2 100644 --- a/lib/wx/c_src/gen/wxe_events.cpp +++ b/lib/wx/c_src/gen/wxe_events.cpp @@ -316,16 +316,6 @@ void initEventTable() } } -void wxeEvtListener::forward(wxEvent& event) -{ -#ifdef DEBUG - if(!sendevent(&event, port)) - fprintf(stderr, "Couldn't send event!\r\n"); -#else -sendevent(&event, port); -#endif -} - int getRef(void* ptr, wxeMemEnv* memenv) { WxeApp * app = (WxeApp *) wxTheApp; @@ -338,7 +328,7 @@ bool sendevent(wxEvent *event, ErlDrvTermData port) char * evClass = NULL; wxMBConvUTF32 UTFconverter; wxeEtype *Etype = etmap[event->GetEventType()]; - wxeCallbackData *cb = (wxeCallbackData *)event->m_callbackUserData; + wxeEvtListener *cb = (wxeEvtListener *)event->m_callbackUserData; WxeApp * app = (WxeApp *) wxTheApp; wxeMemEnv *memenv = app->getMemEnv(port); if(!memenv) return 0; diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 82dd414911..3f5cb4c0f5 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -67,20 +67,8 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) case WXE_INIT_OPENGL: wxe_initOpenGL(rt, bp); break; -case 98: { // wxeEvtListener::wxeEvtListener - wxeEvtListener *Result = new wxeEvtListener(Ecmd.port); - rt.addRef(getRef((void *)Result,memenv), "wxeEvtListener"); - break; -} -case 99: { // wxeEvtListener::destroy - wxObject *This = (wxObject *) getPtr(bp,memenv); - rt.addAtom("ok"); - delete This; - break; -} -case 100: { // wxEvtHandler::Connect - wxeEvtListener *Listener = (wxeEvtListener *) getPtr(bp,memenv); bp += 4; +case 100: { // wxEvtHandler::Connect wxEvtHandler *This = (wxEvtHandler *) getPtr(bp, memenv); bp += 4; int * winid = (int *) bp; bp += 4; int * lastId = (int *) bp; bp += 4; @@ -91,20 +79,22 @@ case 100: { // wxEvtHandler::Connect int * eventTypeLen = (int *) bp; bp += 4; int * class_nameLen = (int *) bp; bp += 4; - if(*haveUserData) { + if(*haveUserData) { userData = new wxeErlTerm(Ecmd.bin[0]); } int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; char *class_name = bp; bp+= *class_nameLen; if(eventType > 0 ) { - wxeCallbackData * Evt_cb = new wxeCallbackData(Ecmd.caller,getRef(This, memenv), - class_name,*fun_cb, - *skip, userData, Listener); + wxeEvtListener * Evt_cb = new wxeEvtListener(Ecmd.caller,getRef(This, memenv), + class_name,*fun_cb, + *skip, userData, Ecmd.port); This->Connect((int) *winid,(int) *lastId,eventType, (wxObjectEventFunction)(wxEventFunction) &wxeEvtListener::forward, - Evt_cb, Listener); + Evt_cb, Evt_cb); rt.addAtom("ok"); + rt.addRef(getRef((void *)Evt_cb,memenv), "wxeEvtListener"); + rt.addTupleCount(2); } else { rt.addAtom("badarg"); rt.addAtom("event_type"); @@ -112,7 +102,7 @@ case 100: { // wxEvtHandler::Connect } break; } -case 101: { // wxEvtHandler::Disconnect +case 101: { // wxEvtHandler::Disconnect wxeEvtListener *Listener = (wxeEvtListener *) getPtr(bp,memenv); bp += 4; wxEvtHandler *This = (wxEvtHandler *) getPtr(bp, memenv); bp += 4; int * winid = (int *) bp; bp += 4; @@ -122,14 +112,14 @@ case 101: { // wxEvtHandler::Disconnect int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; if(eventType > 0) { bool Result = This->Disconnect((int) *winid,(int) *lastId,eventType, - (wxObjectEventFunction)(wxEventFunction) - &wxeEvtListener::forward, - NULL, Listener); + (wxObjectEventFunction)(wxEventFunction) + &wxeEvtListener::forward, + NULL, Listener); rt.addBool(Result); } else { rt.addAtom("badarg"); rt.addAtom("event_type"); - rt.addTupleCount(2); + rt.addTupleCount(2); } break; } diff --git a/lib/wx/c_src/wxe_callback_impl.cpp b/lib/wx/c_src/wxe_callback_impl.cpp index 8ba2557d82..e06f68dcbf 100644 --- a/lib/wx/c_src/wxe_callback_impl.cpp +++ b/lib/wx/c_src/wxe_callback_impl.cpp @@ -30,27 +30,27 @@ * CallbackData * * ****************************************************************************/ -wxeCallbackData::wxeCallbackData(ErlDrvTermData caller, int req, char *req_type, - int funcb, int skip_ev, wxeErlTerm * userData, - wxeEvtListener *handler_cb) - : wxObject() +wxeEvtListener::wxeEvtListener(ErlDrvTermData caller, int req, char *req_type, + int funcb, int skip_ev, wxeErlTerm * userData, + ErlDrvTermData from_port) + : wxEvtHandler() { + port=from_port; listener = caller; obj = req; fun_id = funcb; strcpy(class_name, req_type); skip = skip_ev; user_data = userData; - handler = handler_cb; } -wxeCallbackData::~wxeCallbackData() { - // fprintf(stderr, "CBD Deleteing %p %s\r\n", this, class_name); fflush(stderr); +wxeEvtListener::~wxeEvtListener() { + // fprintf(stderr, "CBD Deleteing %p %s\r\n", this, class_name); fflush(stderr); if(user_data) { delete user_data; } ptrMap::iterator it; - it = ((WxeApp *)wxTheApp)->ptr2ref.find(handler); + it = ((WxeApp *)wxTheApp)->ptr2ref.find(this); if(it != ((WxeApp *)wxTheApp)->ptr2ref.end()) { wxeRefData *refd = it->second; wxeReturn rt = wxeReturn(WXE_DRV_PORT, refd->memenv->owner, false); @@ -61,6 +61,17 @@ wxeCallbackData::~wxeCallbackData() { rt.addTupleCount(4); rt.send(); } + ((WxeApp *)wxTheApp)->clearPtr(this); +} + +void wxeEvtListener::forward(wxEvent& event) +{ +#ifdef DEBUG + if(!sendevent(&event, port)) + fprintf(stderr, "Couldn't send event!\r\n"); +#else +sendevent(&event, port); +#endif } /* *****************************************************************/ diff --git a/lib/wx/c_src/wxe_callback_impl.h b/lib/wx/c_src/wxe_callback_impl.h index c7243e23a4..1c355e4d38 100644 --- a/lib/wx/c_src/wxe_callback_impl.h +++ b/lib/wx/c_src/wxe_callback_impl.h @@ -23,6 +23,24 @@ void pre_callback(); void handle_event_callback(ErlDrvPort port, ErlDrvTermData process); +/* Fun Callback id */ +class wxeEvtListener : public wxEvtHandler +{ +public: + wxeEvtListener(ErlDrvTermData caller, int req, char *req_type, + int funcb, int skip_ev, wxeErlTerm * userData, + ErlDrvTermData Thisport); + ~wxeEvtListener(); + void forward(wxEvent& event); + ErlDrvTermData port; + ErlDrvTermData listener; + int fun_id; + int obj; + char class_name[40]; + int skip; + wxeErlTerm * user_data; +}; + class wxEPrintout : public wxPrintout { public: diff --git a/lib/wx/c_src/wxe_events.h b/lib/wx/c_src/wxe_events.h index 22a737d854..93b5551123 100644 --- a/lib/wx/c_src/wxe_events.h +++ b/lib/wx/c_src/wxe_events.h @@ -32,38 +32,7 @@ public: int cID; }; -/* One EvtListener per listening erlang process */ -/* If callbacks are used the receiver is wxe_master process */ -/* and a wxeEvtListener pre callback is registered */ -class wxeEvtListener : public wxEvtHandler -{ - public: - wxeEvtListener(ErlDrvTermData Thisport) : port(Thisport) - {} - // {fprintf(stderr, "Creating %x\r\n", (unsigned int) this); fflush(stderr);} - ~wxeEvtListener() {} - void forward(wxEvent& event); - ErlDrvTermData port; -}; - void initEventTable(); int wxeEventTypeFromAtom(char *etype_atom); -/* Fun Callback id */ -class wxeCallbackData : public wxObject -{ -public: - wxeCallbackData(ErlDrvTermData caller, int req, char *req_type, - int funcb, int skip_ev, wxeErlTerm * userData, - wxeEvtListener *handler_cb); - ~wxeCallbackData(); - wxeEvtListener * handler; - ErlDrvTermData listener; - int fun_id; - int obj; - char class_name[40]; - int skip; - wxeErlTerm * user_data; -}; - #endif diff --git a/lib/wx/src/gen/wxBufferedDC.erl b/lib/wx/src/gen/wxBufferedDC.erl index c69a426d7f..e2504bbaaa 100644 --- a/lib/wx/src/gen/wxBufferedDC.erl +++ b/lib/wx/src/gen/wxBufferedDC.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 @@ -54,6 +54,8 @@ setUserScale/3,startDoc/2,startPage/1]). -export_type([wxBufferedDC/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxMemoryDC) -> true; parent_class(wxDC) -> true; diff --git a/lib/wx/src/gen/wxBufferedPaintDC.erl b/lib/wx/src/gen/wxBufferedPaintDC.erl index 0e11826da0..c3fa80703c 100644 --- a/lib/wx/src/gen/wxBufferedPaintDC.erl +++ b/lib/wx/src/gen/wxBufferedPaintDC.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 @@ -56,6 +56,8 @@ startPage/1]). -export_type([wxBufferedPaintDC/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxBufferedDC) -> true; parent_class(wxMemoryDC) -> true; diff --git a/lib/wx/src/gen/wxClientDC.erl b/lib/wx/src/gen/wxClientDC.erl index 45909859ce..ae16196774 100644 --- a/lib/wx/src/gen/wxClientDC.erl +++ b/lib/wx/src/gen/wxClientDC.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 @@ -56,6 +56,8 @@ -export_type([wxClientDC/0]). -deprecated([new/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxWindowDC) -> true; parent_class(wxDC) -> true; diff --git a/lib/wx/src/gen/wxEvtHandler.erl b/lib/wx/src/gen/wxEvtHandler.erl index 22c203392c..44b7254cfb 100644 --- a/lib/wx/src/gen/wxEvtHandler.erl +++ b/lib/wx/src/gen/wxEvtHandler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. 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 @@ -46,15 +46,11 @@ -export([connect/2, connect/3, disconnect/1, disconnect/2, disconnect/3]). %% internal exports --export([connect_impl/3, disconnect_impl/2, disconnect_impl/3, - new_evt_listener/0, destroy_evt_listener/1, - get_callback/1, replace_fun_with_id/2]). +-export([connect_impl/2, disconnect_impl/2]). -export_type([wxEvtHandler/0, wx/0, event/0]). -type wxEvtHandler() :: wx:wx_object(). --record(evh, {et=null,id=?wxID_ANY,lastId=?wxID_ANY,skip=undefined,userdata=[],cb=0}). - %% @doc Equivalent to {@link connect/3. connect(This, EventType, [])} -spec connect(This::wxEvtHandler(), EventType::wxEventType()) -> ok. connect(This, EventType) -> @@ -149,55 +145,35 @@ disconnect(This=#wx_ref{type=ThisT,ref=_ThisRef}, EventType, Opts) -> %% @hidden -connect_impl(#wx_ref{type=wxeEvtListener,ref=EvtList}, - #wx_ref{type=ThisT,ref=ThisRef}, - #evh{id=Winid, lastId=LastId, et=EventType, - skip=Skip, userdata=Userdata, cb=FunID}) +connect_impl(#wx_ref{type=ThisT,ref=ThisRef}, + #evh{id=Winid, lastId=LastId, et=EventType, + skip=Skip, userdata=Userdata, cb=FunID}) when is_integer(FunID)-> EventTypeBin = list_to_binary([atom_to_list(EventType)|[0]]), ThisTypeBin = list_to_binary([atom_to_list(ThisT)|[0]]), UD = if Userdata =:= [] -> 0; - true -> + true -> wxe_util:send_bin(term_to_binary(Userdata)), 1 end, - wxe_util:call(100, <<EvtList:32/?UI,ThisRef:32/?UI, + wxe_util:call(100, <<ThisRef:32/?UI, Winid:32/?UI,LastId:32/?UI, (wxe_util:from_bool(Skip)):32/?UI, UD:32/?UI, FunID:32/?UI, (size(EventTypeBin)):32/?UI, - (size(ThisTypeBin)):32/?UI, + (size(ThisTypeBin)):32/?UI, %% Note no alignment EventTypeBin/binary,ThisTypeBin/binary>>). %% @hidden -disconnect_impl(Listener, Object) -> - disconnect_impl(Listener, Object, #evh{}). -%% @hidden -disconnect_impl(#wx_ref{type=wxeEvtListener,ref=EvtList}, - #wx_ref{type=_ThisT,ref=ThisRef}, - #evh{id=Winid, lastId=LastId, et=EventType}) -> +disconnect_impl(#wx_ref{type=_ThisT,ref=ThisRef}, + #evh{id=Winid, lastId=LastId, et=EventType, + handler=#wx_ref{type=wxeEvtListener,ref=EvtList}}) -> EventTypeBin = list_to_binary([atom_to_list(EventType)|[0]]), - wxe_util:call(101, <<EvtList:32/?UI, + wxe_util:call(101, <<EvtList:32/?UI, ThisRef:32/?UI,Winid:32/?UI,LastId:32/?UI, (size(EventTypeBin)):32/?UI, %% Note no alignment EventTypeBin/binary>>). -%% @hidden -new_evt_listener() -> - wxe_util:call(98, <<>>). - -%% @hidden -destroy_evt_listener(#wx_ref{type=wxeEvtListener,ref=EvtList}) -> - wxe_util:call(99, <<EvtList:32/?UI>>). - -%% @hidden -get_callback(#evh{cb=Callback}) -> - Callback. - -%% @hidden -replace_fun_with_id(Evh, Id) -> - Evh#evh{cb=Id}. - diff --git a/lib/wx/src/gen/wxGridCellBoolEditor.erl b/lib/wx/src/gen/wxGridCellBoolEditor.erl index bf7e21d11d..c4d6d92618 100644 --- a/lib/wx/src/gen/wxGridCellBoolEditor.erl +++ b/lib/wx/src/gen/wxGridCellBoolEditor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -34,6 +34,8 @@ parent_class/1,reset/1,setSize/2,show/2,show/3,startingClick/1,startingKey/2]). -export_type([wxGridCellBoolEditor/0]). +-compile([{nowarn_deprecated_function, {wxGridCellEditor,endEdit,4}},{nowarn_deprecated_function, {wxGridCellEditor,paintBackground,3}}]). + %% @hidden parent_class(wxGridCellEditor) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxGridCellChoiceEditor.erl b/lib/wx/src/gen/wxGridCellChoiceEditor.erl index 08c5f9e147..a49680ffda 100644 --- a/lib/wx/src/gen/wxGridCellChoiceEditor.erl +++ b/lib/wx/src/gen/wxGridCellChoiceEditor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -34,6 +34,8 @@ parent_class/1,reset/1,setSize/2,show/2,show/3,startingClick/1,startingKey/2]). -export_type([wxGridCellChoiceEditor/0]). +-compile([{nowarn_deprecated_function, {wxGridCellEditor,endEdit,4}},{nowarn_deprecated_function, {wxGridCellEditor,paintBackground,3}}]). + %% @hidden parent_class(wxGridCellEditor) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxGridCellFloatEditor.erl b/lib/wx/src/gen/wxGridCellFloatEditor.erl index 4b6b3b46e1..5cd0bd6cb5 100644 --- a/lib/wx/src/gen/wxGridCellFloatEditor.erl +++ b/lib/wx/src/gen/wxGridCellFloatEditor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -34,6 +34,8 @@ parent_class/1,reset/1,setSize/2,show/2,show/3,startingClick/1,startingKey/2]). -export_type([wxGridCellFloatEditor/0]). +-compile([{nowarn_deprecated_function, {wxGridCellEditor,endEdit,4}},{nowarn_deprecated_function, {wxGridCellEditor,paintBackground,3}}]). + %% @hidden parent_class(wxGridCellEditor) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxGridCellNumberEditor.erl b/lib/wx/src/gen/wxGridCellNumberEditor.erl index 04214be6b8..7cc682a10e 100644 --- a/lib/wx/src/gen/wxGridCellNumberEditor.erl +++ b/lib/wx/src/gen/wxGridCellNumberEditor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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,6 +35,8 @@ parent_class/1,reset/1,setSize/2,show/2,show/3,startingClick/1,startingKey/2]). -export_type([wxGridCellNumberEditor/0]). +-compile([{nowarn_deprecated_function, {wxGridCellEditor,endEdit,4}},{nowarn_deprecated_function, {wxGridCellEditor,paintBackground,3}}]). + %% @hidden parent_class(wxGridCellTextEditor) -> true; parent_class(wxGridCellEditor) -> true; diff --git a/lib/wx/src/gen/wxGridCellTextEditor.erl b/lib/wx/src/gen/wxGridCellTextEditor.erl index 5755be8638..a024da56c4 100644 --- a/lib/wx/src/gen/wxGridCellTextEditor.erl +++ b/lib/wx/src/gen/wxGridCellTextEditor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -34,6 +34,8 @@ parent_class/1,reset/1,setSize/2,show/2,show/3,startingClick/1,startingKey/2]). -export_type([wxGridCellTextEditor/0]). +-compile([{nowarn_deprecated_function, {wxGridCellEditor,endEdit,4}},{nowarn_deprecated_function, {wxGridCellEditor,paintBackground,3}}]). + %% @hidden parent_class(wxGridCellEditor) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxMemoryDC.erl b/lib/wx/src/gen/wxMemoryDC.erl index c123f0e35d..8de412bdc7 100644 --- a/lib/wx/src/gen/wxMemoryDC.erl +++ b/lib/wx/src/gen/wxMemoryDC.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 @@ -53,6 +53,8 @@ startPage/1]). -export_type([wxMemoryDC/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxDC) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxMirrorDC.erl b/lib/wx/src/gen/wxMirrorDC.erl index cfae34cb36..9a681bff2e 100644 --- a/lib/wx/src/gen/wxMirrorDC.erl +++ b/lib/wx/src/gen/wxMirrorDC.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 @@ -53,6 +53,8 @@ startPage/1]). -export_type([wxMirrorDC/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxDC) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxPaintDC.erl b/lib/wx/src/gen/wxPaintDC.erl index 3c9b321496..0ff27a8c7a 100644 --- a/lib/wx/src/gen/wxPaintDC.erl +++ b/lib/wx/src/gen/wxPaintDC.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 @@ -56,6 +56,8 @@ -export_type([wxPaintDC/0]). -deprecated([new/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxWindowDC) -> true; parent_class(wxDC) -> true; diff --git a/lib/wx/src/gen/wxPostScriptDC.erl b/lib/wx/src/gen/wxPostScriptDC.erl index e0b22c87eb..e7e498efa1 100644 --- a/lib/wx/src/gen/wxPostScriptDC.erl +++ b/lib/wx/src/gen/wxPostScriptDC.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 @@ -55,6 +55,8 @@ -export_type([wxPostScriptDC/0]). -deprecated([getResolution/0,setResolution/1]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxDC) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxScreenDC.erl b/lib/wx/src/gen/wxScreenDC.erl index 54bdc2d351..21ca4bacfc 100644 --- a/lib/wx/src/gen/wxScreenDC.erl +++ b/lib/wx/src/gen/wxScreenDC.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 @@ -53,6 +53,8 @@ startPage/1]). -export_type([wxScreenDC/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxDC) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxWindowDC.erl b/lib/wx/src/gen/wxWindowDC.erl index f5c482d8ca..6bb303cfe6 100644 --- a/lib/wx/src/gen/wxWindowDC.erl +++ b/lib/wx/src/gen/wxWindowDC.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 @@ -55,6 +55,8 @@ -export_type([wxWindowDC/0]). -deprecated([new/0]). +-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). + %% @hidden parent_class(wxDC) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/wxe.hrl b/lib/wx/src/wxe.hrl index bd34b13385..66ec9ac45e 100644 --- a/lib/wx/src/wxe.hrl +++ b/lib/wx/src/wxe.hrl @@ -29,6 +29,11 @@ -record(wx_mem, {bin, size}). +-record(evh, {et=null,id=-1,lastId=-1,cb=0, + skip=undefined,userdata=[], % temp + handler=undefined % added after connect + }). + -define(CLASS(Type,Class), ((Type) =:= Class) orelse (Type):parent_class(Class)). -define(CLASS_T(Type,Class), diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 04e0d0faf4..aed9dca7ce 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -36,8 +36,8 @@ terminate/2, code_change/3]). -record(state, {port,cb_port,users,cleaners=[],cb,cb_cnt}). --record(user, {events=[], evt_handler}). --record(event, {object, callback, cb_handler}). +-record(user, {events=[]}). +%%-record(event, {object, callback, cb_handler}). -define(APPLICATION, wxe). -define(log(S,A), log(?MODULE,?LINE,S,A)). @@ -119,7 +119,7 @@ handle_call(stop,{_From,_},State = #state{users=Users0, cleaners=Cs0}) -> Env = get(?WXE_IDENTIFIER), Users = gb_trees:to_list(Users0), Cs = lists:map(fun({_Pid,User}) -> - spawn_link(fun() -> cleanup(Env,[User], false) end) + spawn_link(fun() -> cleanup(Env,[User]) end) end, Users), {noreply, State#state{users=gb_trees:empty(), cleaners=Cs ++ Cs0}}; @@ -178,13 +178,13 @@ handle_info({'DOWN',_,process,Pid,_}, State=#state{users=Users0,cleaners=Cs}) -> Users = gb_trees:delete(Pid,Users0), Env = wx:get_env(), case User of - #user{events=[], evt_handler=undefined} -> %% No need to spawn + #user{events=[]} -> %% No need to spawn case Cs =:= [] andalso gb_trees:is_empty(Users) of - true -> {stop, normal, State#state{cleaners=Cs}}; - false -> {noreply, State#state{users=Users,cleaners=Cs}} + true -> {stop, normal, State#state{users=Users}}; + false -> {noreply, State#state{users=Users}} end; _ -> - Cleaner = spawn_link(fun() -> cleanup(Env,[User],true) end), + Cleaner = spawn_link(fun() -> cleanup(Env,[User]) end), {noreply, State#state{users=Users,cleaners=[Cleaner|Cs]}} end catch _E:_R -> @@ -222,36 +222,26 @@ code_change(_OldVsn, State, _Extra) -> log(Mod,Line,Str,Args) -> error_logger:format("~p:~p: " ++ Str, [Mod,Line|Args]). -handle_connect(Object, EvData, From, State0 = #state{users=Users}) -> - User0 = #user{events=Evs0,evt_handler=Handler0} = gb_trees:get(From, Users), - Callback = wxEvtHandler:get_callback(EvData), - case Handler0 of - #wx_ref{} when Callback =:= 0 -> - CBHandler = Handler0, - Handler = Handler0; - undefined when Callback =:= 0 -> - Handler = new_evt_listener(State0, From), - CBHandler = Handler; - _ -> - CBHandler = new_evt_listener(State0, From), - Handler = Handler0 - end, - Evs = [#event{object=Object,callback=Callback, cb_handler=CBHandler}|Evs0], - User = User0#user{events=Evs, evt_handler=Handler}, - State1 = State0#state{users=gb_trees:update(From, User, Users)}, - if is_function(Callback) orelse is_pid(Callback) -> - {FunId, State} = attach_fun(Callback,State1), - Res = wxEvtHandler:connect_impl(CBHandler,Object, - wxEvtHandler:replace_fun_with_id(EvData,FunId)), - case Res of - ok -> {reply,Res,State}; - _Error -> {reply,Res,State0} - end; - - true -> - Res = {call_impl, connect_cb, CBHandler}, - {reply, Res, State1} - end. +handle_connect(Object, #evh{handler=undefined, cb=Callback} = EvData0, + From, State0) -> + %% Callback let this process listen to the events + {FunId, State} = attach_fun(Callback,State0), + EvData1 = EvData0#evh{cb=FunId}, + case wxEvtHandler:connect_impl(Object,EvData1) of + {ok, Handler} -> + EvData = EvData1#evh{handler=Handler,userdata=undefined}, + handle_connect(Object, EvData, From, State); + Error -> + {reply, Error, State0} + end; +handle_connect(Object, EvData=#evh{handler=Handler}, + From, State0 = #state{users=Users}) -> + %% Correct process is already listening just register it + put(Handler, From), + User0 = #user{events=Listeners0} = gb_trees:get(From, Users), + User = User0#user{events=[{Object,EvData}|Listeners0]}, + State = State0#state{users=gb_trees:update(From, User, Users)}, + {reply, ok, State}. invoke_cb({{Ev=#wx{}, Ref=#wx_ref{}}, FunId,_}, _S) -> %% Event callbacks @@ -329,20 +319,6 @@ get_wx_object_state(Pid) -> _ -> ignore end. -new_evt_listener(State, Owner) -> - #wx_env{port=Port} = wx:get_env(), - _ = erlang:port_control(Port,98,<<>>), - Listener = get_result(State), - put(Listener, Owner), - Listener. - -get_result(_State) -> - receive - {'_wxe_result_', Res} -> Res; - {'_wxe_error_', Op, Error} -> - erlang:error({Error, {wxEvtHandler, {internal_installer, Op}}}) - end. - attach_fun(Fun, S = #state{cb=CB,cb_cnt=Next}) -> case gb_trees:lookup(Fun,CB) of {value, ID} -> @@ -367,90 +343,72 @@ delete_fun(FunId, State = #state{cb=CB}) -> State end. -cleanup_evt_listener(U=#user{events=Evs0,evt_handler=Handler}, EvtListener, Object) -> - {Evs, Del} = lists:foldl(fun(#event{object=Obj,cb_handler=CBH}, {Acc, Delete}) - when CBH =:= EvtListener, Obj =:= Object -> - {Acc, Delete}; - (Event = #event{cb_handler=CBH}, {Acc, _Delete}) - when CBH =:= EvtListener -> - {[Event|Acc], false}; - (Event, {Acc, Delete}) -> - {[Event|Acc], Delete} - end, {[], true}, Evs0), - Del andalso wxEvtHandler:destroy_evt_listener(EvtListener), - case Del andalso Handler =:= EvtListener of - true -> - U#user{events=Evs, evt_handler=undefined}; - false -> - U#user{events=Evs} - end. +cleanup_evt_listener(U=#user{events=Evs0}, EvtListener, Object) -> + Filter = fun({Obj,#evh{handler=Evl}}) -> + not (Object =:= Obj andalso Evl =:= EvtListener) + end, + U#user{events=lists:filter(Filter, Evs0)}. -handle_disconnect(Object, Evh, From, State0 = #state{users=Users0}) -> +handle_disconnect(Object, Evh = #evh{cb=Fun}, From, + State0 = #state{users=Users0, cb=Callbacks}) -> #user{events=Evs0} = gb_trees:get(From, Users0), - Fun = wxEvtHandler:get_callback(Evh), - case find_handler(Evs0, Object, Fun) of - [] -> {reply, false, State0}; + FunId = gb_trees:lookup(Fun, Callbacks), + case find_handler(Evs0, Object, Evh#evh{cb=FunId}) of + [] -> + {reply, false, State0}; Handlers -> - case disconnect(Object,Evh, Handlers) of - #event{} -> - {reply, true, State0}; - Result -> - {reply, Result, State0} + case disconnect(Object,Handlers) of + #evh{} -> {reply, true, State0}; + Result -> {reply, Result, State0} end end. -disconnect(Object,Evh,[Ev=#event{cb_handler=Handler}|Evs]) -> - try wxEvtHandler:disconnect_impl(Handler,Object,Evh) of +disconnect(Object,[Ev|Evs]) -> + try wxEvtHandler:disconnect_impl(Object,Ev) of true -> Ev; - false -> disconnect(Object, Evh, Evs); + false -> disconnect(Object, Evs); Error -> Error catch _:_ -> false end; -disconnect(_, _, []) -> false. - -find_handler(Evs, Object, Fun) -> - find_handler(Evs, Object, Fun, []). - -find_handler([Ev =#event{object=Object,callback=FunReg}|Evs],Object,Search,Acc) -> - case FunReg =:= Search of - true -> find_handler(Evs,Object,Search,[Ev|Acc]); - false when is_function(FunReg), Search =:= 0 -> - find_handler(Evs,Object,Search,[Ev|Acc]); - _ -> - find_handler(Evs,Object,Search,Acc) +disconnect(_, []) -> false. + +find_handler([{Object,Evh}|Evs], Object, Match) -> + case match_handler(Match, Evh) of + false -> find_handler(Evs, Object, Match); + Res -> [Res|find_handler(Evs,Object,Match)] end; -find_handler([_|Evs],Object,Fun,Res) -> - find_handler(Evs,Object,Fun,Res); -find_handler([],_Object,_Fun,Res) -> - Res. +find_handler([_|Evs], Object, Match) -> + find_handler(Evs, Object, Match); +find_handler([], _, _) -> []. + +match_handler(M=#evh{et=MET, cb=MCB}, + #evh{et=ET, cb=CB, handler=Handler}) -> + %% Let wxWidgets handle the id matching + Match = match_et(MET, ET) + andalso match_cb(MCB, CB), + Match andalso M#evh{handler=Handler}. +match_et(null, _) -> true; +match_et(Met, Et) -> Met =:= Et. + +match_cb(none, _) -> true; +match_cb({value,MId}, Id) -> MId =:= Id. %% Cleanup %% The server handles callbacks from driver so every other wx call must %% be called from another process, therefore the cleaning must be spawned. %% -%% Using Disconnect when we terminate can crash, it is timing releated -%% but it seems that disconnect on windows that are being deleted are bad. -%% Since we are terminating the data will be cleaned up anyway. -cleanup(Env, Data, Disconnect) -> +cleanup(Env, Data) -> put(?WXE_IDENTIFIER, Env), - lists:foreach(fun(User) -> cleanup(User, Disconnect) end, Data), + Disconnect = fun({Object, Ev}) -> + try wxEvtHandler:disconnect_impl(Object,Ev) + catch _:_ -> ok + end + end, + + lists:foreach(fun(#user{events=Evs}) -> + [Disconnect(Ev) || Ev <- Evs] + end, Data), gen_server:cast(Env#wx_env.sv, {cleaned, self()}), normal. - -cleanup(#user{events=Evs, evt_handler=Handler}, Disconnect) -> - lists:foreach(fun(#event{object=O, callback=CB, cb_handler=CbH}) -> - Disconnect andalso (catch wxEvtHandler:disconnect_impl(CbH,O)), - case is_function(CB) of - true -> - wxEvtHandler:destroy_evt_listener(CbH); - false -> - ignore - end - end, Evs), - case Handler of - undefined -> ignore; - _ -> wxEvtHandler:destroy_evt_listener(Handler) - end, - ok. diff --git a/lib/wx/src/wxe_util.erl b/lib/wx/src/wxe_util.erl index a31c3e30b8..02ac4ddfa6 100644 --- a/lib/wx/src/wxe_util.erl +++ b/lib/wx/src/wxe_util.erl @@ -74,7 +74,7 @@ call(Op, Args) -> true -> debug_call(Dbg band 15, Op, Args, Port) end. - + rec(Op) -> receive {'_wxe_result_', Res} -> Res; @@ -108,21 +108,26 @@ send_bin(Bin) when is_binary(Bin) -> get_cbId(Fun) -> gen_server:call((wx:get_env())#wx_env.sv,{register_cb, Fun}, infinity). -connect_cb(Object,EvData) -> - handle_listener(connect_cb, Object, EvData). - -disconnect_cb(Object,EvData) -> - handle_listener(disconnect_cb, Object, EvData). - -handle_listener(Op,Object,EvData) -> - Listener = gen_server:call((wx:get_env())#wx_env.sv, {Op,Object,EvData}, infinity), - case Listener of - {call_impl, connect_cb, EvtList} -> - wxEvtHandler:connect_impl(EvtList,Object,EvData); - Res -> - Res +connect_cb(Object,EvData0 = #evh{cb=Callback}) -> + Server = (wx:get_env())#wx_env.sv, + case Callback of + 0 -> %% Message api connect from this process + case wxEvtHandler:connect_impl(Object,EvData0) of + {ok, Listener} -> + EvData = EvData0#evh{handler=Listener, userdata=undefined}, + gen_server:call(Server, {connect_cb,Object,EvData}, infinity); + Error -> + Error + end; + _ -> %% callback, fun or pid (pid for wx_object:sync_events masked callbacks) + %% let the server do the connect + gen_server:call(Server, {connect_cb,Object,EvData0}, infinity) end. +disconnect_cb(Object,EvData) -> + Server = (wx:get_env())#wx_env.sv, + gen_server:call(Server, {disconnect_cb,Object,EvData}, infinity). + debug_cast(1, Op, _Args, _Port) -> check_previous(), case ets:lookup(wx_debug_info,Op) of diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index 79dbea0575..7bdbd4594c 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.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 @@ -98,8 +98,23 @@ several_apps(Config) -> Pids = [spawn_link(fun() -> several_apps(Parent, N, Config) end) || N <- lists:seq(1,4)], process_flag(trap_exit,true), - ?m_multi_receive([{complete,Pid} || Pid <- Pids]), + Wait = fun(Pid,Acc) -> + receive {complete, Pid} -> Acc + after 20000 -> [Pid|Acc] + end + end, + Res = lists:foldl(Wait, [], Pids), [Pid ! quit || Pid <- Pids], + + Dbg = fun(Pid) -> + io:format("Stack ~p~n",[erlang:process_info(Pid, current_stacktrace)]), + io:format("Stack ~p~n",[erlang:process_info(Pid)]) + end, + case Res of + [] -> ok; + Failed -> + [Dbg(Pid)|| Pid <- Failed] + end, case wx_test_lib:user_available(Config) of true -> receive {'EXIT',_,foo} -> ok end; @@ -216,7 +231,7 @@ create_menus(Frame) -> %% Test the wx_misc.erl api functionality. wx_misc(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); -wx_misc(Config) -> +wx_misc(_Config) -> wx:new([{debug, trace}]), put(wx_test_verbose, true), ?m(ok, wx_misc:bell()), diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index b9c2fafe0e..076f16ba16 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -149,7 +149,7 @@ disconnect(Config) -> timer:sleep(1000), wx_test_lib:flush(), - ?m({'EXIT', {{badarg,_},_}}, wxEvtHandler:disconnect(Panel, non_existing_event_type)), + ?m(false, wxEvtHandler:disconnect(Panel, non_existing_event_type)), ?m(true, wxEvtHandler:disconnect(Panel, size)), ?m(ok, wxWindow:setSize(Panel, {200,102})), timer:sleep(1000), @@ -499,14 +499,14 @@ callback_clean(Config) -> end end), timer:sleep(500), %% Give it time to remove it - ?m({[{Pid,_,_}],[_],[_]}, white_box_check_event_handlers()), + ?m({[{Pid,_}],[_],[_]}, white_box_check_event_handlers()), Pid ! remove, timer:sleep(500), %% Give it time to remove it ?m({[],[],[]}, white_box_check_event_handlers()), SetupEventHandlers(), - ?m({[{_,_,_}],[_],[_]}, white_box_check_event_handlers()), + ?m({[{_,_}],[_],[_]}, white_box_check_event_handlers()), wxDialog:show(Dlg), wx_test_lib:wx_close(Dlg, Config), @@ -526,9 +526,9 @@ white_box_check_event_handlers() -> {status, _, _, [Env, _, _, _, Data]} = sys:get_status(Server), [_H, _data, {data, [{_, Record}]}] = Data, {state, _Port1, _Port2, Users, [], CBs, _Next} = Record, - {[{Pid, Evs, Listener} || - {Pid, {user, Evs, Listener}} <- gb_trees:to_list(Users), - (Evs =/= [] orelse Listener =/= undefined)], %% Ignore empty + {[{Pid, Evs} || + {Pid, {user, Evs}} <- gb_trees:to_list(Users), + Evs =/= []], %% Ignore empty gb_trees:to_list(CBs), [Funs || Funs = {Id, {Fun,_}} <- Env, is_integer(Id), is_function(Fun)] }. |