aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/src/asn1ct_check.erl41
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EnumExt.asn12
-rw-r--r--lib/asn1/test/testEnumExt.erl4
-rw-r--r--lib/common_test/test/ct_telnet_SUITE.erl29
-rw-r--r--lib/compiler/src/beam_validator.erl4
-rw-r--r--lib/compiler/src/v3_core.erl492
-rw-r--r--lib/crypto/c_src/crypto.c87
-rw-r--r--lib/crypto/c_src/crypto_callback.c22
-rw-r--r--lib/crypto/doc/src/crypto.xml8
-rw-r--r--lib/debugger/src/dbg_wx_filedialog_win.erl19
-rw-r--r--lib/debugger/src/dbg_wx_mon.erl4
-rw-r--r--lib/debugger/src/dbg_wx_mon_win.erl4
-rw-r--r--lib/debugger/src/dbg_wx_trace.erl4
-rw-r--r--lib/debugger/src/dbg_wx_view.erl4
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml2
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl14
-rw-r--r--lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options1
-rw-r--r--lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings5
-rw-r--r--lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/lc_warnings.erl95
-rw-r--r--lib/dialyzer/test/unmatched_returns_SUITE_data/src/lc_warnings/opaque_atom_adt.erl9
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl23
-rw-r--r--lib/gs/doc/src/gs.xml4
-rw-r--r--lib/jinterface/doc/src/jinterface_users_guide.xml4
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java293
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpExternal.java3
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java20
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java5
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/java_files1
-rw-r--r--lib/jinterface/test/jinterface_SUITE.erl18
-rw-r--r--lib/jinterface/test/jinterface_SUITE_data/Makefile.src3
-rw-r--r--lib/jinterface/test/jinterface_SUITE_data/Maps.java108
-rw-r--r--lib/kernel/doc/src/application.xml17
-rw-r--r--lib/kernel/src/application.erl20
-rw-r--r--lib/kernel/src/application_controller.erl48
-rw-r--r--lib/kernel/test/application_SUITE.erl49
-rw-r--r--lib/observer/src/cdv_bin_cb.erl24
-rw-r--r--lib/observer/src/cdv_html_wx.erl26
-rw-r--r--lib/observer/src/cdv_term_cb.erl21
-rw-r--r--lib/observer/src/observer_html_lib.erl77
-rw-r--r--lib/observer/src/observer_lib.erl12
-rw-r--r--lib/observer/src/observer_procinfo.erl8
-rw-r--r--lib/observer/src/observer_wx.erl4
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl35
-rw-r--r--lib/ssh/doc/src/ssh.xml5
-rw-r--r--lib/ssh/src/ssh.erl6
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl2
-rw-r--r--lib/ssh/src/ssh_message.erl26
-rw-r--r--lib/ssl/src/ssl.erl43
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl33
-rw-r--r--lib/stdlib/doc/src/ets.xml6
-rw-r--r--lib/stdlib/src/edlin_expand.erl14
-rw-r--r--lib/stdlib/src/erl_expand_records.erl14
-rw-r--r--lib/stdlib/src/supervisor.erl5
-rw-r--r--lib/stdlib/src/supervisor_bridge.erl11
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl168
-rw-r--r--lib/stdlib/test/erl_expand_records_SUITE.erl21
-rw-r--r--lib/stdlib/test/ets_SUITE.erl18
-rw-r--r--lib/test_server/src/configure.in27
-rw-r--r--lib/test_server/src/test_server_ctrl.erl29
-rw-r--r--lib/test_server/src/test_server_sup.erl65
-rw-r--r--lib/tools/emacs/erlang.el6
-rw-r--r--lib/wx/api_gen/Makefile4
-rw-r--r--lib/wx/api_gen/wx_extra/wxEvtHandler.c_src36
-rw-r--r--lib/wx/api_gen/wx_extra/wxEvtHandler.erl46
-rw-r--r--lib/wx/api_gen/wx_gen_cpp.erl11
-rw-r--r--lib/wx/api_gen/wx_gen_erl.erl28
-rw-r--r--lib/wx/c_src/gen/wxe_events.cpp12
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp36
-rw-r--r--lib/wx/c_src/wxe_callback_impl.cpp27
-rw-r--r--lib/wx/c_src/wxe_callback_impl.h18
-rw-r--r--lib/wx/c_src/wxe_events.h31
-rw-r--r--lib/wx/src/gen/wxBufferedDC.erl4
-rw-r--r--lib/wx/src/gen/wxBufferedPaintDC.erl4
-rw-r--r--lib/wx/src/gen/wxClientDC.erl4
-rw-r--r--lib/wx/src/gen/wxEvtHandler.erl48
-rw-r--r--lib/wx/src/gen/wxGridCellBoolEditor.erl4
-rw-r--r--lib/wx/src/gen/wxGridCellChoiceEditor.erl4
-rw-r--r--lib/wx/src/gen/wxGridCellFloatEditor.erl4
-rw-r--r--lib/wx/src/gen/wxGridCellNumberEditor.erl4
-rw-r--r--lib/wx/src/gen/wxGridCellTextEditor.erl4
-rw-r--r--lib/wx/src/gen/wxMemoryDC.erl4
-rw-r--r--lib/wx/src/gen/wxMirrorDC.erl4
-rw-r--r--lib/wx/src/gen/wxPaintDC.erl4
-rw-r--r--lib/wx/src/gen/wxPostScriptDC.erl4
-rw-r--r--lib/wx/src/gen/wxScreenDC.erl4
-rw-r--r--lib/wx/src/gen/wxWindowDC.erl4
-rw-r--r--lib/wx/src/wxe.hrl5
-rw-r--r--lib/wx/src/wxe_server.erl192
-rw-r--r--lib/wx/src/wxe_util.erl33
-rw-r--r--lib/wx/test/wx_basic_SUITE.erl21
-rw-r--r--lib/wx/test/wx_event_SUITE.erl12
91 files changed, 1812 insertions, 976 deletions
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index f94f3b56bc..df034c96ad 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -2642,16 +2642,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.
@@ -3786,8 +3789,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 +3844,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),
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/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/v3_core.erl b/lib/compiler/src/v3_core.erl
index ec5deb6905..3435a46ca9 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -101,6 +101,8 @@
-record(ireceive2, {anno=#a{},clauses,timeout,action}).
-record(iset, {anno=#a{},var,arg}).
-record(itry, {anno=#a{},args,vars,body,evars,handler}).
+-record(ifilter, {anno=#a{},arg}).
+-record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}).
-type iapply() :: #iapply{}.
-type ibinary() :: #ibinary{}.
@@ -117,10 +119,13 @@
-type ireceive2() :: #ireceive2{}.
-type iset() :: #iset{}.
-type itry() :: #itry{}.
+-type ifilter() :: #ifilter{}.
+-type igen() :: #igen{}.
-type i() :: iapply() | ibinary() | icall() | icase() | icatch()
| iclause() | ifun() | iletrec() | imatch() | iprimop()
- | iprotect() | ireceive1() | ireceive2() | iset() | itry().
+ | iprotect() | ireceive1() | ireceive2() | iset() | itry()
+ | ifilter() | igen().
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
@@ -479,8 +484,9 @@ expr({cons,L,H0,T0}, St0) ->
{T1,Tps,St2} = safe(T0, St1),
A = lineno_anno(L, St2),
{ann_c_cons(A, H1, T1),Hps ++ Tps,St2};
-expr({lc,L,E,Qs}, St) ->
- lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St);
+expr({lc,L,E,Qs0}, St0) ->
+ {Qs1,St1} = preprocess_quals(L, Qs0, St0),
+ lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1);
expr({bc,L,E,Qs}, St) ->
bc_tq(L, E, Qs, {nil,L}, St);
expr({tuple,L,Es0}, St0) ->
@@ -647,7 +653,7 @@ expr({match,L,P0,E0}, St0) ->
Other when not is_atom(Other) ->
{#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
end;
-expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
+expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
%%
%% To avoid achieving quadratic complexity if there is a chain of
@@ -655,7 +661,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
%% evaluation of More now. Evaluating More here could also reduce the
%% number variables in the environment for letrec.
{Mc,Mps,St1} = safe(More, St0),
- {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1),
+ {Qs,St2} = preprocess_quals(Llc, Qs0, St1),
+ {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2),
{Y,Mps++Yps,St};
expr({op,L,'andalso',E1,E2}, St0) ->
{#c_var{name=V0},St} = new_var(L, St0),
@@ -889,136 +896,45 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
-%% This gets a bit messy as we must transform all directly here. We
-%% recognise guard tests and try to fold them together and join to a
-%% preceding generators, this should give us better and more compact
-%% code.
-lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
+lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
+ skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
+ arg={Pre,Arg}}|Qs], Mc, St0) ->
{Name,St1} = new_fun_name("lc", St0),
- {Head,St2} = new_var(St1),
- {Tname,St3} = new_var_name(St2),
- LA = lineno_anno(Line, St3),
- CGAnno = #a{anno=[list_comprehension|LA]},
- LAnno = #a{anno=LA},
- Tail = #c_var{anno=LA,name=Tname},
- {Arg,St4} = new_var(St3),
- {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4),
- {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
- {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
- {Pc,St8} = list_gen_pattern(P, Line, St7),
- {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
- Fc = function_clause([Arg], LA, {Name,1}),
-
- %% Avoid constructing a default clause if the list comprehension
- %% only has a variable as generator and there are no guard
- %% tests. In other words, if the comprehension is equivalent to
- %% lists:map/2.
- Cs0 = case {Guardc, Pc} of
- {[], #c_var{}} ->
- [#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]}],guard=[],
- body=[Mc]}];
- _ ->
- [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[ann_c_cons(LA, Head, Tail)],
- guard=[],
- body=[Nc]},
- #iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]}],guard=[],
- body=[Mc]}]
- end,
- Cs = case Pc of
- nomatch -> Cs0;
- _ ->
- [#iclause{anno=LAnno,
- pats=[ann_c_cons(LA, Pc, Tail)],
- guard=Guardc,
- body=Lps ++ [Lc]}|Cs0]
- end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Gc]}]},
- [],St9};
-lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Name,St1} = new_fun_name("blc", St0),
LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
- CGAnno = #a{anno=[list_comprehension|LA]},
- HeadBinPattern = pattern(P, St1),
- #c_binary{segments=Ps0} = HeadBinPattern,
- {Ps,Tail,St2} = append_tail_segment(Ps0, St1),
- {EPs,St3} = emasculate_segments(Ps, St2),
- Pattern = HeadBinPattern#c_binary{segments=Ps},
- EPattern = HeadBinPattern#c_binary{segments=EPs},
- {Arg,St4} = new_var(St3),
- {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
- Tname = Tail#c_var.name,
- {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
- {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
- {Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
- Fc = function_clause([Arg], LA, {Name,1}),
- {TailSegList,_,St} = append_tail_segment([], St10),
- Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[Pattern],
- guard=Guardc,
- body=Bps ++ [Bc]},
- #iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[EPattern],
- guard=[],
- body=[#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Tail]}]},
- #iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
- body=[Mc]}],
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,1}},
- args=[Gc]}]},
- [],St};
-lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
- %% Special case sequences guard tests.
- LA = lineno_anno(element(2, Fil0), St0),
- LAnno = #a{anno=LA},
- CGAnno = #a{anno=[list_comprehension|LA]},
- case is_guard_test(Fil0) of
- true ->
- {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0),
- {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=CGAnno,
- args=[],
- clauses=[#iclause{anno=LAnno,pats=[],
- guard=Gs,body=Lps ++ [Lc]}],
- fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[],guard=[],body=[Mc]}},
- [],St2};
- false ->
- {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0),
- {Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], LA,
- c_tuple([#c_literal{val=case_clause},Fpat])),
- %% Do a novars little optimisation here.
- {Filc,Fps,St3} = novars(Fil0, St2),
- {#icase{anno=CGAnno,
- args=[Filc],
- clauses=[#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=true}],
- guard=[],
- body=Lps ++ [Lc]},
- #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[#c_literal{anno=LA,val=false}],
- guard=[],
- body=[Mc]}],
- fc=Fc},
- Fps,St3}
- end;
+ F = #c_var{anno=LA,name={Name,1}},
+ Nc = #iapply{anno=GAnno,op=F,args=[Tail]},
+ {Var,St2} = new_var(St1),
+ Fc = function_clause([Var], LA, {Name,1}),
+ TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]},
+ Cs0 = case {AccPat,AccGuard} of
+ {SkipPat,[]} ->
+ %% Skip and accumulator patterns are the same and there is
+ %% no guard, no need to generate a skip clause.
+ [TailClause];
+ _ ->
+ [#iclause{anno=#a{anno=[compiler_generated|LA]},
+ pats=[SkipPat],guard=[],body=[Nc]},
+ TailClause]
+ end,
+ {Cs,St4} = case AccPat of
+ nomatch ->
+ %% The accumulator pattern never matches, no need
+ %% for an accumulator clause.
+ {Cs0,St2};
+ _ ->
+ {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2),
+ {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard,
+ body=Lps ++ [Lc]}|Cs0],
+ St3}
+ end,
+ Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
+ {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}],
+ body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]},
+ [],St4};
+lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
+ filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5);
lc_tq(Line, E0, [], Mc0, St0) ->
{H1,Hps,St1} = safe(E0, St0),
{T1,Tps,St} = force_safe(Mc0, St1),
@@ -1028,146 +944,60 @@ lc_tq(Line, E0, [], Mc0, St0) ->
%% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}.
%% This TQ from Gustafsson ERLANG'05.
-%% This gets a bit messy as we must transform all directly here. We
-%% recognise guard tests and try to fold them together and join to a
-%% preceding generators, this should give us better and more compact
-%% code.
%% More could be transformed before calling bc_tq.
-bc_tq(Line, Exp, Qualifiers, _, St0) ->
+bc_tq(Line, Exp, Qs0, _, St0) ->
{BinVar,St1} = new_var(St0),
- {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1),
- {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2),
+ {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1),
+ {Qs,St3} = preprocess_quals(Line, Qs0, St2),
+ {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3),
Pre = SzPre ++
[#iset{var=BinVar,
arg=#iprimop{name=#c_literal{val=bs_init_writable},
args=[Sz]}}] ++ BcPre,
{E,Pre,St}.
-bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Name,St1} = new_fun_name("lbc", St0),
- LA = lineno_anno(Line, St1),
- {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1),
- LAnno = #a{anno=LA},
- CGAnno = #a{anno=[list_comprehension|LA]},
- {Arg,St3} = new_var(St2),
- NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
- {var,Lg,AccVar#c_var.name}]},
- {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat!
- {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4),
- {Nc,Nps,St6} = expr(NewMore, St5),
- {Pc,St7} = list_gen_pattern(P, Line, St6),
- {Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
- Fc = function_clause([Arg,AccVar], LA, {Name,2}),
- Cs0 = case {Guardc, Pc} of
- {[], #c_var{}} ->
- [#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
- body=[AccVar]}];
- _ ->
- [#iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[ann_c_cons(LA, Head, Tail),AccVar],
- guard=[],
- body=Nps ++ [Nc]},
- #iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
- body=[AccVar]}]
- end,
- Cs = case Pc of
- nomatch -> Cs0;
- _ ->
- Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc],
- [#iclause{anno=LAnno,
- pats=[ann_c_cons(LA,Pc,Tail),AccVar],
- guard=Guardc,
- body=Body}|Cs0]
- end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
- {#iletrec{anno=CGAnno,defs=[{{Name,2},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,2}},
- args=[Gc,AccExpr]}]},
- [],St8};
-bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
- {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
+bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard,
+ skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
+ arg={Pre,Arg}}|Qs], Mc, St0) ->
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
- {AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
- CGAnno = #a{anno=[list_comprehension|LA]},
- HeadBinPattern = pattern(P, St2),
- #c_binary{segments=Ps0} = HeadBinPattern,
- {Ps,Tail,St3} = append_tail_segment(Ps0, St2),
- {EPs,St4} = emasculate_segments(Ps, St3),
- Pattern = HeadBinPattern#c_binary{segments=Ps},
- EPattern = HeadBinPattern#c_binary{segments=EPs},
- {Arg,St5} = new_var(St4),
- NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
- {var,Lg,AccVar#c_var.name}]},
- {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
- {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
- {Nc,Nps,St8} = expr(NewMore, St7),
- {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
- Fc = function_clause([Arg,AccVar], LA, {Name,2}),
- Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
- {TailSegList,_,St} = append_tail_segment([], St9),
- Cs = [#iclause{anno=LAnno,
- pats=[Pattern,AccVar],
- guard=Guardc,
- body=Body},
- #iclause{anno=#a{anno=[compiler_generated|LA]},
- pats=[EPattern,AccVar],
- guard=[],
- body=Nps ++ [Nc]},
- #iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
- guard=[],
- body=[AccVar]}],
- Fun = #ifun{anno=CGAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
- body=Gps ++ [#iapply{anno=LAnno,
- op=#c_var{anno=LA,name={Name,2}},
- args=[Gc,AccExpr]}]},
- [],St};
-bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
- %% Special case sequences guard tests.
- LA = lineno_anno(element(2, Fil0), St0),
- LAnno = #a{anno=LA},
- CGAnno = #a{anno=[list_comprehension|LA]},
- case is_guard_test(Fil0) of
- true ->
- {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
- {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0),
- {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=CGAnno,
- args=[],
- clauses=[#iclause{anno=LAnno,
- pats=[],
- guard=Gs,body=Bps ++ [Bc]}],
- fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[],guard=[],body=[AccVar]}},
- [],St};
- false ->
- {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0),
- {Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], LA,
- c_tuple([#c_literal{val=case_clause},Fpat])),
- %% Do a novars little optimisation here.
- {Filc,Fps,St} = novars(Fil0, St2),
- {#icase{anno=CGAnno,
- args=[Filc],
- clauses=[#iclause{anno=LAnno,
- pats=[#c_literal{anno=LA,val=true}],
- guard=[],
- body=Bps ++ [Bc]},
- #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
- pats=[#c_literal{anno=LA,val=false}],
- guard=[],
- body=[AccVar]}],
- fc=Fc},
- Fps,St}
- end;
+ {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1),
+ F = #c_var{anno=LA,name={Name,2}},
+ Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]},
+ Fc = function_clause(Vars, LA, {Name,2}),
+ TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[],
+ body=[AccVar]},
+ Cs0 = case {AccPat,AccGuard} of
+ {SkipPat,[]} ->
+ %% Skip and accumulator patterns are the same and there is
+ %% no guard, no need to generate a skip clause.
+ [TailClause];
+ _ ->
+ [#iclause{anno=#a{anno=[compiler_generated|LA]},
+ pats=[SkipPat,AccVar],guard=[],body=[Nc]},
+ TailClause]
+ end,
+ {Cs,St4} = case AccPat of
+ nomatch ->
+ %% The accumulator pattern never matches, no need
+ %% for an accumulator clause.
+ {Cs0,St2};
+ _ ->
+ {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2),
+ Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc],
+ {[#iclause{anno=LAnno,
+ pats=[AccPat,AccVar],guard=AccGuard,
+ body=Body}|Cs0],
+ St3}
+ end,
+ Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc},
+ {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}],
+ body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]},
+ [],St4};
+bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
+ filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5);
bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
{E,Pre,St} = expr({bin,Bl,[{bin_element,Bl,
{var,Bl,AccVar#c_var.name},
@@ -1175,16 +1005,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
[binary,{unit,1}]}|Elements]}, St0),
#a{anno=A} = Anno0 = get_anno(E),
Anno = Anno0#a{anno=[compiler_generated,single_use|A]},
- %%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
+%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) ->
+%% {Case,[PreExpr],State}.
+%% Transform an intermediate comprehension filter to its intermediate case
+%% representation.
+
+filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}},
+ Mc, St0, Qs, TqFun) ->
+ %% The filter is an expression, it is compiled to a case of degree 1 with
+ %% 3 clauses, one accumulating, one skipping and the final one throwing
+ %% {case_clause,Value} where Value is the result of the filter and is not a
+ %% boolean.
+ {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0),
+ {FailPat,St2} = new_var(St1),
+ Fc = fail_clause([FailPat], LA,
+ c_tuple([#c_literal{val=case_clause},FailPat])),
+ {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg],
+ clauses=[#iclause{anno=LAnno,
+ pats=[#c_literal{val=true}],guard=[],
+ body=Lps ++ [Lc]},
+ #iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
+ pats=[#c_literal{val=false}],guard=[],
+ body=[Mc]}],
+ fc=Fc},
+ Pre,St2};
+filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard},
+ Mc, St0, Qs, TqFun) when is_list(Guard) ->
+ %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses,
+ %% the first matches if the guard succeeds and the comprehension continues
+ %% or the second one is selected and the current element is skipped.
+ {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0),
+ {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[],
+ clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}],
+ fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
+ pats=[],guard=[],body=[Mc]}},
+ [],St1}.
+
+%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}.
+%% Preprocess a list of Erlang qualifiers into its intermediate representation,
+%% represented as a list of #igen{} and #ifilter{} records. We recognise guard
+%% tests and try to fold them together and join to a preceding generators, this
+%% should give us better and more compact code.
+
+preprocess_quals(Line, Qs, St) ->
+ preprocess_quals(Line, Qs, St, []).
+
+preprocess_quals(Line, [Q|Qs0], St0, Acc) ->
+ case is_generator(Q) of
+ true ->
+ {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0),
+ {Gen,St} = generator(Line, Q, Gs, St0),
+ preprocess_quals(Line, Qs, St, [Gen|Acc]);
+ false ->
+ LAnno = #a{anno=lineno_anno(get_anno(Q), St0)},
+ case is_guard_test(Q) of
+ true ->
+ %% When a filter is a guard test, its argument in the
+ %% #ifilter{} record is a list as returned by
+ %% lc_guard_tests/2.
+ {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0),
+ {Cg,St} = lc_guard_tests([Q|Gs], St0),
+ Filter = #ifilter{anno=LAnno,arg=Cg},
+ preprocess_quals(Line, Qs, St, [Filter|Acc]);
+ false ->
+ %% Otherwise, it is a pair {Pre,Arg} as in a generator
+ %% input.
+ {Ce,Pre,St} = novars(Q, St0),
+ Filter = #ifilter{anno=LAnno,arg={Pre,Ce}},
+ preprocess_quals(Line, Qs0, St, [Filter|Acc])
+ end
+ end;
+preprocess_quals(_, [], St, Acc) ->
+ {reverse(Acc),St}.
+
+is_generator({generate,_,_,_}) -> true;
+is_generator({b_generate,_,_,_}) -> true;
+is_generator(_) -> false.
+
+%%
+%% Generators are abstracted as sextuplets:
+%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr.
+%% - acc_guard is the list of guards immediately following the current
+%% generator in the qualifier list input.
+%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for
+%% <<X,1:X>> <= Expr.
+%% - tail is the variable used in AccPat and SkipPat bound to the rest of the
+%% generator input.
+%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list
+%% and bit string generators.
+%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be
+%% inserted before the comprehension function and Arg is the expression
+%% that it should be passed.
+%%
+
+%% generator(Line, Generator, Guard, State) -> {Generator',State}.
+%% Transform a given generator into its #igen{} representation.
+
+generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
+ LA = lineno_anno(Line, St0),
+ GA = lineno_anno(Lg, St0),
+ {Head,St1} = list_gen_pattern(P0, Line, St0),
+ {[Tail,Skip],St2} = new_vars(2, St1),
+ {Cg,St3} = lc_guard_tests(Gs, St2),
+ {AccPat,SkipPat} = case Head of
+ #c_var{} ->
+ %% If the generator pattern is a variable, the
+ %% pattern from the accumulator clause can be
+ %% reused in the skip one. lc_tq and bc_tq1 takes
+ %% care of dismissing the latter in that case.
+ Cons = ann_c_cons(LA, Head, Tail),
+ {Cons,Cons};
+ nomatch ->
+ %% If it never matches, there is no need for
+ %% an accumulator clause.
+ {nomatch,ann_c_cons(LA, Skip, Tail)};
+ _ ->
+ {ann_c_cons(LA, Head, Tail),
+ ann_c_cons(LA, Skip, Tail)}
+ end,
+ {Ce,Pre,St4} = safe(E, St3),
+ Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
+ tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}},
+ {Gen,St4};
+generator(Line, {b_generate,Lg,P,E}, Gs, St0) ->
+ LA = lineno_anno(Line, St0),
+ GA = lineno_anno(Lg, St0),
+ Cp = #c_binary{segments=Segs} = pattern(P, St0),
+ %% The function append_tail_segment/2 keeps variable patterns as-is, making
+ %% it possible to have the same skip clause removal as with list generators.
+ {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0),
+ AccPat = Cp#c_binary{segments=AccSegs},
+ {Cg,St2} = lc_guard_tests(Gs, St1),
+ {SkipSegs,St3} = emasculate_segments(AccSegs, St2),
+ SkipPat = Cp#c_binary{segments=SkipSegs},
+ {Ce,Pre,St4} = safe(E, St3),
+ Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
+ tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]},
+ arg={Pre,Ce}},
+ {Gen,St4}.
+
append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
unit=#c_literal{val=1},
type=#c_literal{val=binary},
flags=#c_literal{val=[unsigned,big]}},
- {Segs++[Tail],Var,St}.
+ {Segs++[Tail],Var,Tail,St}.
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
@@ -1195,7 +1163,7 @@ emasculate_segments([B|Rest], St0, Acc) ->
{Var,St1} = new_var(St0),
emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]);
emasculate_segments([], St, Acc) ->
- {lists:reverse(Acc),St}.
+ {reverse(Acc),St}.
lc_guard_tests([], St) -> {[],St};
lc_guard_tests(Gs0, St0) ->
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 925ad0c091..2e1a21178f 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2014. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -444,6 +444,15 @@ static ERL_NIF_TERM atom_ppbasis;
static ERL_NIF_TERM atom_onbasis;
#endif
+static ErlNifResourceType* hmac_context_rtype;
+struct hmac_context
+{
+ ErlNifMutex* mtx;
+ int alive;
+ HMAC_CTX ctx;
+};
+static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*);
+
/*
#define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n")
#define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1)
@@ -498,6 +507,15 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info)
return 0;
}
+ hmac_context_rtype = enif_open_resource_type(env, NULL, "hmac_context",
+ (ErlNifResourceDtor*) hmac_context_dtor,
+ ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
+ NULL);
+ if (!hmac_context_rtype) {
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'");
+ return 0;
+ }
+
if (library_refc > 0) {
/* Repeated loading of this library (module upgrade).
* Atoms and callbacks are already set, we are done.
@@ -1280,11 +1298,19 @@ static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
#endif
}
+static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj)
+{
+ if (obj->alive) {
+ HMAC_CTX_cleanup(&obj->ctx);
+ obj->alive = 0;
+ }
+ enif_mutex_destroy(obj->mtx);
+}
+
static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Key) */
ErlNifBinary key;
- ERL_NIF_TERM ret;
- unsigned char * ctx_buf;
+ struct hmac_context* obj;
const EVP_MD *md;
if (argv[0] == atom_sha) md = EVP_sha1();
@@ -1309,57 +1335,60 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
return enif_make_badarg(env);
}
- ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret);
- HMAC_CTX_init((HMAC_CTX *) ctx_buf);
- HMAC_Init((HMAC_CTX *) ctx_buf, key.data, key.size, md);
+ obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context));
+ obj->mtx = enif_mutex_create("crypto.hmac");
+ obj->alive = 1;
+ HMAC_CTX_init(&obj->ctx);
+ HMAC_Init(&obj->ctx, key.data, key.size, md);
- return ret;
+ return enif_make_resource(env, obj);
}
static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
- ErlNifBinary context, data;
- ERL_NIF_TERM ret;
- unsigned char * ctx_buf;
+ ErlNifBinary data;
+ struct hmac_context* obj;
- if (!enif_inspect_binary(env, argv[0], &context)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)
- || context.size != sizeof(HMAC_CTX)) {
+ if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)
+ || !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
+ return enif_make_badarg(env);
+ }
+ enif_mutex_lock(obj->mtx);
+ if (!obj->alive) {
+ enif_mutex_unlock(obj->mtx);
return enif_make_badarg(env);
}
+ HMAC_Update(&obj->ctx, data.data, data.size);
+ enif_mutex_unlock(obj->mtx);
- ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret);
- memcpy(ctx_buf, context.data, context.size);
- HMAC_Update((HMAC_CTX *)ctx_buf, data.data, data.size);
CONSUME_REDS(env,data);
-
- return ret;
+ return argv[0];
}
static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context) or (Context, HashLen) */
- ErlNifBinary context;
ERL_NIF_TERM ret;
- HMAC_CTX ctx;
+ struct hmac_context* obj;
unsigned char mac_buf[EVP_MAX_MD_SIZE];
unsigned char * mac_bin;
unsigned int req_len = 0;
unsigned int mac_len;
- if (!enif_inspect_binary(env, argv[0], &context)) {
- return enif_make_badarg(env);
- }
- if (argc == 2 && !enif_get_uint(env, argv[1], &req_len)) {
+ if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj)
+ || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) {
return enif_make_badarg(env);
}
- if (context.size != sizeof(ctx)) {
- return enif_make_badarg(env);
+ enif_mutex_lock(obj->mtx);
+ if (!obj->alive) {
+ enif_mutex_unlock(obj->mtx);
+ return enif_make_badarg(env);
}
- memcpy(&ctx, context.data, context.size);
- HMAC_Final(&ctx, mac_buf, &mac_len);
- HMAC_CTX_cleanup(&ctx);
+ HMAC_Final(&obj->ctx, mac_buf, &mac_len);
+ HMAC_CTX_cleanup(&obj->ctx);
+ obj->alive = 0;
+ enif_mutex_unlock(obj->mtx);
if (argc == 2 && req_len < mac_len) {
/* Only truncate to req_len bytes if asked. */
diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c
index 81106b4cc2..a08dcec463 100644
--- a/lib/crypto/c_src/crypto_callback.c
+++ b/lib/crypto/c_src/crypto_callback.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2014. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -17,6 +17,7 @@
* %CopyrightEnd%
*/
+#include <stdio.h>
#include <string.h>
#include <openssl/opensslconf.h>
@@ -51,13 +52,28 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks);
static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */
+static void nomem(size_t size, const char* op)
+{
+ fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n",
+ op, size);
+ abort();
+}
+
static void* crypto_alloc(size_t size)
{
- return enif_alloc(size);
+ void *ret = enif_alloc(size);
+
+ if (!ret && size)
+ nomem(size, "allocate");
+ return ret;
}
static void* crypto_realloc(void* ptr, size_t size)
{
- return enif_realloc(ptr, size);
+ void* ret = enif_realloc(ptr, size);
+
+ if (!ret && size)
+ nomem(size, "reallocate");
+ return ret;
}
static void crypto_free(void* ptr)
{
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 40f829e704..c95827c371 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1999</year><year>2013</year>
+ <year>1999</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -366,7 +366,11 @@
or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and
<seealso marker="#hmac_final_n-2">hmac_final_n</seealso>
</p>
-
+ <warning><p>Do not use a <c>Context</c> as argument in more than one
+ call to hmac_update or hmac_final. The semantics of reusing old contexts
+ in any way is undefined and could even crash the VM in earlier releases.
+ The reason for this limitation is a lack of support in the underlying
+ OpenSSL API.</p></warning>
</desc>
</func>
diff --git a/lib/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/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/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 c3bf1ac012..76a80553b0 100644
--- a/lib/kernel/src/application.erl
+++ b/lib/kernel/src/application.erl
@@ -285,16 +285,18 @@ info() ->
set_env(Application, Key, Val) ->
application_controller:set_env(Application, Key, Val).
--spec set_env(Application, Par, Val, Timeout) -> 'ok' when
+-spec set_env(Application, Par, Val, Opts) -> 'ok' when
Application :: atom(),
Par :: atom(),
Val :: term(),
- Timeout :: timeout().
+ Opts :: [{timeout, timeout()} | {persistent, boolean()}].
set_env(Application, Key, Val, infinity) ->
- application_controller:set_env(Application, Key, Val, infinity);
+ set_env(Application, Key, Val, [{timeout, infinity}]);
set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 ->
- application_controller:set_env(Application, Key, Val, Timeout).
+ set_env(Application, Key, Val, [{timeout, Timeout}]);
+set_env(Application, Key, Val, Opts) when is_list(Opts) ->
+ application_controller:set_env(Application, Key, Val, Opts).
-spec unset_env(Application, Par) -> 'ok' when
Application :: atom(),
@@ -303,15 +305,17 @@ set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 ->
unset_env(Application, Key) ->
application_controller:unset_env(Application, Key).
--spec unset_env(Application, Par, Timeout) -> 'ok' when
+-spec unset_env(Application, Par, Opts) -> 'ok' when
Application :: atom(),
Par :: atom(),
- Timeout :: timeout().
+ Opts :: [{timeout, timeout()} | {persistent, boolean()}].
unset_env(Application, Key, infinity) ->
- application_controller:unset_env(Application, Key, infinity);
+ unset_env(Application, Key, [{timeout, infinity}]);
unset_env(Application, Key, Timeout) when is_integer(Timeout), Timeout>=0 ->
- application_controller:unset_env(Application, Key, Timeout).
+ unset_env(Application, Key, [{timeout, Timeout}]);
+unset_env(Application, Key, Opts) when is_list(Opts) ->
+ application_controller:unset_env(Application, Key, Opts).
-spec get_env(Par) -> 'undefined' | {'ok', Val} when
Par :: atom(),
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index 1a4473593a..ed13035104 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -461,14 +461,16 @@ permit_application(ApplName, Flag) ->
set_env(AppName, Key, Val) ->
- gen_server:call(?AC, {set_env, AppName, Key, Val}).
-set_env(AppName, Key, Val, Timeout) ->
- gen_server:call(?AC, {set_env, AppName, Key, Val}, Timeout).
+ gen_server:call(?AC, {set_env, AppName, Key, Val, []}).
+set_env(AppName, Key, Val, Opts) ->
+ Timeout = proplists:get_value(timeout, Opts, 5000),
+ gen_server:call(?AC, {set_env, AppName, Key, Val, Opts}, Timeout).
unset_env(AppName, Key) ->
- gen_server:call(?AC, {unset_env, AppName, Key}).
-unset_env(AppName, Key, Timeout) ->
- gen_server:call(?AC, {unset_env, AppName, Key}, Timeout).
+ gen_server:call(?AC, {unset_env, AppName, Key, []}).
+unset_env(AppName, Key, Opts) ->
+ Timeout = proplists:get_value(timeout, Opts, 5000),
+ gen_server:call(?AC, {unset_env, AppName, Key, Opts}, Timeout).
%%%-----------------------------------------------------------------
%%% call-back functions from gen_server
@@ -609,8 +611,8 @@ check_para([Else | _ParaList], AppName) ->
| {'change_application_data', _, _}
| {'permit_application', atom() | {'application',atom(),_},_}
| {'start_application', _, _}
- | {'unset_env', _, _}
- | {'set_env', _, _, _}.
+ | {'unset_env', _, _, _}
+ | {'set_env', _, _, _, _}.
-spec handle_call(calls(), {pid(), term()}, state()) ->
{'noreply', state()} | {'reply', term(), state()}.
@@ -858,13 +860,25 @@ handle_call(which_applications, _From, S) ->
end, S#state.running),
{reply, Reply, S};
-handle_call({set_env, AppName, Key, Val}, _From, S) ->
+handle_call({set_env, AppName, Key, Val, Opts}, _From, S) ->
ets:insert(ac_tab, {{env, AppName, Key}, Val}),
- {reply, ok, S};
+ case proplists:get_value(persistent, Opts, false) of
+ true ->
+ Fun = fun(Env) -> lists:keystore(Key, 1, Env, {Key, Val}) end,
+ {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}};
+ false ->
+ {reply, ok, S}
+ end;
-handle_call({unset_env, AppName, Key}, _From, S) ->
+handle_call({unset_env, AppName, Key, Opts}, _From, S) ->
ets:delete(ac_tab, {env, AppName, Key}),
- {reply, ok, S};
+ case proplists:get_value(persistent, Opts, false) of
+ true ->
+ Fun = fun(Env) -> lists:keydelete(Key, 1, Env) end,
+ {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}};
+ false ->
+ {reply, ok, S}
+ end;
handle_call({control_application, AppName}, {Pid, _Tag}, S) ->
Control = S#state.control,
@@ -1640,6 +1654,16 @@ merge_env([{App, AppEnv1} | T], Env2, Res) ->
merge_env([], Env2, Res) ->
Env2 ++ Res.
+%% Changes the environment for the given application
+%% If there is no application, an empty one is created
+change_app_env(Env, App, Fun) ->
+ case get_env_key(App, Env) of
+ {value, AppEnv, RestEnv} ->
+ [{App, Fun(AppEnv)} | RestEnv];
+ _ ->
+ [{App, Fun([])} | Env]
+ end.
+
%% Merges envs for an application. Env2 overrides Env1
merge_app_env(Env1, Env2) ->
merge_app_env(Env1, Env2, []).
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index 9ec8a15861..ff62297f2d 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -33,7 +33,7 @@
permit_false_start_local/1, permit_false_start_dist/1, script_start/1,
nodedown_start/1, init2973/0, loop2973/0, loop5606/1]).
--export([config_change/1,
+-export([config_change/1, persistent_env/1,
distr_changed_tc1/1, distr_changed_tc2/1,
ensure_started/1, ensure_all_started/1,
shutdown_func/1, do_shutdown/1, shutdown_timeout/1]).
@@ -53,7 +53,8 @@ all() ->
load_use_cache, ensure_started, {group, reported_bugs}, start_phases,
script_start, nodedown_start, permit_false_start_local,
permit_false_start_dist, get_key, get_env, ensure_all_started,
- {group, distr_changed}, config_change, shutdown_func, shutdown_timeout].
+ {group, distr_changed}, config_change, shutdown_func, shutdown_timeout,
+ persistent_env].
groups() ->
[{reported_bugs, [],
@@ -1987,6 +1988,50 @@ get_appls([_ | T], Res) ->
get_appls([], Res) ->
Res.
+persistent_env(suite) ->
+ [];
+persistent_env(doc) ->
+ ["Test set_env/4 and unset_env/3 with persistent true"];
+persistent_env(Conf) when is_list(Conf) ->
+ ok = application:set_env(appinc, own2, persist, [{persistent, true}]),
+ ok = application:set_env(appinc, key1, persist, [{persistent, true}]),
+
+ %% own_env1 and own2 are set in appinc
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, key1),
+
+ %% Changing the environment after loaded reflects and should persist
+ ok = application:set_env(appinc, own_env1, persist, [{persistent, true}]),
+ {ok, persist} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, key1),
+
+ %% On reload, own_env1, own2 and key1 should all persist
+ ok = application:unload(appinc),
+ ok = application:load(appinc()),
+ {ok, persist} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, key1),
+
+ %% Unset own_env1 and key1, own2 should still persist
+ ok = application:unset_env(appinc, own_env1, [{persistent, true}]),
+ ok = application:unset_env(appinc, key1, [{persistent, true}]),
+ undefined = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ undefined = application:get_env(appinc, key1),
+
+ %% own_env1 should be back to its application value on reload
+ ok = application:unload(appinc),
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ undefined = application:get_env(appinc, key1),
+
+ %% Clean up
+ ok = application:unload(appinc).
+
%%%-----------------------------------------------------------------
%%% Tests the 'shutdown_func' kernel config parameter
%%%-----------------------------------------------------------------
diff --git a/lib/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 = ["&lt;&lt;",
- [integer_to_list(X)++"," || <<X:8>> <= PreviewBin],
- "...(",
- observer_lib:to_str({bytes,Size}),
- ")&gt;&gt;"],
+ 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 = ["&lt;&lt;",
- [integer_to_list(X)++"," || <<X:8>> <= PreviewBin],
- "...(",
- observer_lib:to_str({bytes,list_to_integer(Size)}),
- ")&gt;&gt;"],
+ [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 ->
+ ["&lt;&lt;",
+ remove_lgt(io_lib:format("~p",[PreviewBin])),
+ "...(",
+ observer_lib:to_str({bytes,Size}),
+ ")",
+ "&gt;&gt"];
+preview_string(_, PreviewBin) ->
+ ["&lt;&lt;",
+ remove_lgt(io_lib:format("~p",[PreviewBin])),
+ "&gt;&gt"].
+
+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]) ->
+ ["&lt;"|replace_lgt(R)];
+replace_lgt([$>|R]) ->
+ ["&gt;"|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/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_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index 4741bef6b9..f53c6e1278 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -135,9 +135,10 @@ pattern({tuple,Line,Ps}, St0) ->
pattern({map,Line,Ps}, St0) ->
{TPs,St1} = pattern_list(Ps, St0),
{{map,Line,TPs},St1};
-pattern({map_field_exact,Line,Key,V0}, St0) ->
- {V,St1} = pattern(V0, St0),
- {{map_field_exact,Line,Key,V},St1};
+pattern({map_field_exact,Line,Key0,V0}, St0) ->
+ {Key,St1} = pattern(Key0, St0),
+ {V,St2} = pattern(V0, St1),
+ {{map_field_exact,Line,Key,V},St2};
%%pattern({struct,Line,Tag,Ps}, St0) ->
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
%% {{struct,Line,Tag,TPs},TPsvs,St1};
@@ -310,9 +311,10 @@ expr({tuple,Line,Es0}, St0) ->
expr({map,Line,Es0}, St0) ->
{Es1,St1} = expr_list(Es0, St0),
{{map,Line,Es1},St1};
-expr({map,Line,Var,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{map,Line,Var,Es1},St1};
+expr({map,Line,Arg0,Es0}, St0) ->
+ {Arg1,St1} = expr(Arg0, St0),
+ {Es1,St2} = expr_list(Es0, St1),
+ {{map,Line,Arg1,Es1},St2};
expr({map_field_assoc,Line,K0,V0}, St0) ->
{K,St1} = expr(K0, St0),
{V,St2} = expr(V0, St1),
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index d18387568d..974583bc28 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -45,10 +45,13 @@
-type restart() :: 'permanent' | 'transient' | 'temporary'.
-type shutdown() :: 'brutal_kill' | timeout().
-type worker() :: 'worker' | 'supervisor'.
--type sup_name() :: {'local', Name :: atom()} | {'global', Name :: atom()}.
+-type sup_name() :: {'local', Name :: atom()}
+ | {'global', Name :: atom()}
+ | {'via', Module :: module(), Name :: any()}.
-type sup_ref() :: (Name :: atom())
| {Name :: atom(), Node :: node()}
| {'global', Name :: atom()}
+ | {'via', Module :: module(), Name :: any()}
| pid().
-type child_spec() :: {Id :: child_id(),
StartFunc :: mfargs(),
diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl
index e8405ab9a4..ff4502f0b9 100644
--- a/lib/stdlib/src/supervisor_bridge.erl
+++ b/lib/stdlib/src/supervisor_bridge.erl
@@ -101,7 +101,16 @@ handle_cast(_, State) ->
{noreply, State}.
handle_info({'EXIT', Pid, Reason}, State) when State#state.pid =:= Pid ->
- report_error(child_terminated, Reason, State),
+ case Reason of
+ normal ->
+ ok;
+ shutdown ->
+ ok;
+ {shutdown, _Term} ->
+ ok;
+ _ ->
+ report_error(child_terminated, Reason, State)
+ end,
{stop, Reason, State#state{pid = undefined}};
handle_info(_, State) ->
{noreply, State}.
diff --git a/lib/stdlib/test/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_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl
index 94b4397a9c..43e679f7ed 100644
--- a/lib/stdlib/test/erl_expand_records_SUITE.erl
+++ b/lib/stdlib/test/erl_expand_records_SUITE.erl
@@ -38,7 +38,7 @@
-export([attributes/1, expr/1, guard/1,
init/1, pattern/1, strict/1, update/1,
otp_5915/1, otp_7931/1, otp_5990/1,
- otp_7078/1, otp_7101/1]).
+ otp_7078/1, otp_7101/1, maps/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(1)).
@@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[attributes, expr, guard, init,
- pattern, strict, update, {group, tickets}].
+ pattern, strict, update, maps, {group, tickets}].
groups() ->
[{tickets, [],
@@ -402,7 +402,22 @@ update(Config) when is_list(Config) ->
],
?line run(Config, Ts),
ok.
-
+
+maps(Config) when is_list(Config) ->
+ Ts = [<<"-record(rr, {a,b,c}).
+ t() ->
+ R0 = id(#rr{a=1,b=2,c=3}),
+ R1 = id(#rr{a=4,b=5,c=6}),
+ [{R0,R1}] =
+ maps:to_list(#{#rr{a=1,b=2,c=3} => #rr{a=4,b=5,c=6}}),
+ #{#rr{a=1,b=2,c=3} := #rr{a=1,b=2,c=3}} =
+ #{#rr{a=1,b=2,c=3} => R1}#{#rr{a=1,b=2,c=3} := R0},
+ ok.
+
+ id(X) -> X.
+ ">>],
+ run(Config, Ts, [strict_record_tests]),
+ ok.
otp_5915(doc) ->
"Strict record tests in guards.";
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 82c3e7ecaf..8dc8b2c291 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -75,6 +75,7 @@
-export([otp_9932/1]).
-export([otp_9423/1]).
-export([otp_10182/1]).
+-export([ets_all/1]).
-export([memory_check_summary/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -151,6 +152,7 @@ all() ->
otp_10182,
otp_9932,
otp_9423,
+ ets_all,
memory_check_summary]. % MUST BE LAST
@@ -5565,7 +5567,19 @@ otp_10182(Config) when is_list(Config) ->
ets:delete(Db),
In = Out.
-
+%% Test that ets:all include/exclude tables that we know are created/deleted
+ets_all(Config) when is_list(Config) ->
+ Pids = [spawn_link(fun() -> ets_all_run() end) || _ <- [1,2]],
+ receive after 3*1000 -> ok end,
+ [begin unlink(P), exit(P,kill) end || P <- Pids],
+ ok.
+
+ets_all_run() ->
+ Table = ets:new(undefined, []),
+ true = lists:member(Table, ets:all()),
+ ets:delete(Table),
+ false = lists:member(Table, ets:all()),
+ ets_all_run().
%
diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in
index 067663feb4..cd723bcd4d 100644
--- a/lib/test_server/src/configure.in
+++ b/lib/test_server/src/configure.in
@@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang.
dnl
dnl %CopyrightBegin%
dnl
-dnl Copyright Ericsson AB 1997-2013. All Rights Reserved.
+dnl Copyright Ericsson AB 1997-2014. All Rights Reserved.
dnl
dnl The contents of this file are subject to the Erlang Public License,
dnl Version 1.1, (the "License"); you may not use this file except in
@@ -170,7 +170,30 @@ case $system in
fi
SHLIB_EXTRACT_ALL=""
;;
- *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*)
+ *-openbsd*)
+ # Not available on all versions: check for include file.
+ AC_CHECK_HEADER(dlfcn.h, [
+ SHLIB_CFLAGS="-fpic"
+ SHLIB_LD="${CC}"
+ SHLIB_LDFLAGS="$LDFLAGS -shared"
+ SHLIB_SUFFIX=".so"
+ if test X${enable_m64_build} = Xyes; then
+ AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers)
+ fi
+ if test X${enable_m32_build} = Xyes; then
+ AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers)
+ fi
+ ], [
+ # No dynamic loading.
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld"
+ SHLIB_LDFLAGS=""
+ SHLIB_SUFFIX=""
+ AC_MSG_ERROR(don't know how to compile and link dynamic drivers)
+ ])
+ SHLIB_EXTRACT_ALL=""
+ ;;
+ *-netbsd*|*-freebsd*|*-dragonfly*)
# Not available on all versions: check for include file.
AC_CHECK_HEADER(dlfcn.h, [
SHLIB_CFLAGS="-fpic"
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index e24d6ceacb..dcf905db24 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -487,6 +487,7 @@ init([]) ->
ok
end,
test_server_sup:cleanup_crash_dumps(),
+ test_server_sup:util_start(),
State = #state{jobs=[],finish=false},
TI0 = test_server:init_target_info(),
TargetHost = test_server_sup:hoststr(),
@@ -1055,6 +1056,7 @@ handle_info(_, State) ->
%% test suites (if any) and any possible remainting slave node
terminate(_Reason, State) ->
+ test_server_sup:util_stop(),
case State#state.trc of
false -> ok;
Sock -> test_server_node:stop_tracer_node(Sock)
@@ -1725,30 +1727,33 @@ make_html_link(LinkName, Target, Explanation) ->
ok = write_html_file(LinkName, H).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_minor_log_file(Mod, Func) -> AbsName
+%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
%% Mod = atom()
%% Func = atom()
+%% ParallelTC = bool()
%% AbsName = string()
%%
%% Create a minor log file for the test case Mod,Func,Args. The log file
-%% will be stored in the log directory under the name <Mod>.<Func>.log.
-%% Some header info will also be inserted into the log file.
+%% will be stored in the log directory under the name <Mod>.<Func>.html.
+%% Some header info will also be inserted into the log file. If the test
+%% case runs in a parallel group, then to avoid clashing file names if the
+%% case is executed more than once, the name <Mod>.<Func>.<Timestamp>.html
+%% is used.
-start_minor_log_file(Mod, Func) ->
+start_minor_log_file(Mod, Func, ParallelTC) ->
MFA = {Mod,Func,1},
LogDir = get(test_server_log_dir_base),
Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
Name = downcase(Name0),
AbsName = filename:join(LogDir, Name),
- case file:read_file_info(AbsName) of
- {error,_} -> %% normal case, unique name
+ case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
+ false -> %% normal case, unique name
start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
- {ok,_} -> %% special case, duplicate names
- {_,S,Us} = now(),
+ true -> %% special case, duplicate names
+ Tag = test_server_sup:unique_name(),
Name1_0 =
- lists:flatten(io_lib:format("~w.~w.~w.~w~ts", [Mod,Func,S,
- trunc(Us/1000),
- ?html_ext])),
+ lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
+ ?html_ext])),
Name1 = downcase(Name1_0),
AbsName1 = filename:join(LogDir, Name1),
start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
@@ -3631,7 +3636,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
TSDir = get(test_server_dir),
print(major, "=case ~w:~w", [Mod, Func]),
- MinorName = start_minor_log_file(Mod, Func),
+ MinorName = start_minor_log_file(Mod, Func, self() /= Main),
print(minor, "<a name=\"top\"></a>", [], internal_raw),
MinorBase = filename:basename(MinorName),
print(major, "=logfile ~ts", [filename:basename(MinorName)]),
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 377aa21018..70ead42b1b 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -29,10 +29,12 @@
hostatom/0, hostatom/1, hoststr/0, hoststr/1,
framework_call/2,framework_call/3,framework_call/4,
format_loc/1,
+ util_start/0, util_stop/0, unique_name/0,
call_trace/1]).
-include("test_server_internal.hrl").
-define(crash_dump_tar,"crash_dumps.tar.gz").
-define(src_listing_ext, ".src.html").
+-record(util_state, {starter, latest_name}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap(Timeout,Scale,Pid) -> Handle
@@ -583,6 +585,69 @@ downcase([], Result) ->
lists:reverse(Result).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% util_start() -> ok
+%%
+%% Start local utility process
+util_start() ->
+ Starter = self(),
+ case whereis(?MODULE) of
+ undefined ->
+ spawn_link(fun() ->
+ register(?MODULE, self()),
+ util_loop(#util_state{starter=Starter})
+ end);
+ _Pid ->
+ ok
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% util_stop() -> ok
+%%
+%% Stop local utility process
+util_stop() ->
+ try (?MODULE ! {self(),stop}) of
+ _ ->
+ receive {?MODULE,stopped} -> ok
+ after 5000 -> exit(whereis(?MODULE), kill)
+ end
+ catch
+ _:_ ->
+ ok
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% unique_name() -> string()
+%%
+unique_name() ->
+ ?MODULE ! {self(),unique_name},
+ receive {?MODULE,Name} -> Name
+ after 5000 -> exit({?MODULE,no_util_process})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% util_loop(State) -> ok
+%%
+util_loop(State) ->
+ receive
+ {From,unique_name} ->
+ {_,S,Us} = now(),
+ Ms = trunc(Us/1000),
+ Name = lists:flatten(io_lib:format("~w.~w", [S,Ms])),
+ if Name == State#util_state.latest_name ->
+ timer:sleep(1),
+ self() ! {From,unique_name},
+ util_loop(State);
+ true ->
+ From ! {?MODULE,Name},
+ util_loop(State#util_state{latest_name = Name})
+ end;
+ {From,stop} ->
+ catch unlink(State#util_state.starter),
+ From ! {?MODULE,stopped},
+ ok
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% call_trace(TraceSpecFile) -> ok
%%
%% Read terms on format {m,Mod} | {f,Mod,Func}
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 3a868f1300..f007f780eb 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -664,6 +664,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"is_function"
"is_integer"
"is_list"
+ "is_map"
"is_number"
"is_pid"
"is_port"
@@ -715,7 +716,8 @@ resulting regexp is surrounded by \\_< and \\_>."
"pos_integer"
"string"
"term"
- "timeout")
+ "timeout"
+ "map")
"Erlang type specs types"))
(eval-and-compile
@@ -772,6 +774,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"is_function"
"is_integer"
"is_list"
+ "is_map"
"is_number"
"is_pid"
"is_port"
@@ -791,6 +794,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"list_to_tuple"
"load_module"
"make_ref"
+ "map_size"
"max"
"min"
"module_loaded"
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)]
}.