diff options
34 files changed, 799 insertions, 396 deletions
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 2d888862bf..fbdddf09db 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -157,6 +157,7 @@ bif erts_internal:binary_to_term/2 bif erts_internal:request_system_task/3 bif erts_internal:check_process_code/2 +bif erts_internal:map_to_tuple_keys/1 # inet_db support bif erlang:port_set_data/2 diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index fdd2d0c0f6..5e740aacdd 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -58,6 +58,8 @@ * - maps:size/1 * - maps:without/2 * + * DEBUG: for sharing calculation + * - erts_internal:map_to_tuple_keys/1 */ /* erlang:map_size/1 @@ -819,3 +821,17 @@ int erts_validate_and_sort_map(map_t* mp) } return 1; } + +/* + * erts_internal:map_to_tuple_keys/1 + * + * Used in erts_debug:size/1 + */ + +BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + map_t *mp = (map_t*)map_val(BIF_ARG_1); + BIF_RET(mp->keys); + } + BIF_ERROR(BIF_P, BADARG); +} diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 87778dd0c2..e5c904cfb9 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -67,6 +67,9 @@ test_size(Config) when is_list(Config) -> 2 = do_test_size({[]}), 3 = do_test_size({a,b}), 7 = do_test_size({a,[b,c]}), + 8 = do_test_size(#{b => 2,c => 3}), + 4 = do_test_size(#{}), + 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}), %% Test internal consistency of sizes, but without testing %% exact sizes. @@ -97,6 +100,9 @@ test_size(Config) when is_list(Config) -> do_test_size({SimplestFun,SimplestFun}, 2*FunSz0+do_test_size({a,b}), FunSz0+do_test_size({a,b})), + + M = id(#{ "atom" => first, i => 0}), + do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32), ok. do_test_size(Term) -> diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex d41c833e05..3d650aff74 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index edcd50c77e..764d7730aa 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -31,6 +31,7 @@ -export([await_port_send_result/3]). -export([binary_to_term/1, binary_to_term/2]). -export([cmp_term/2]). +-export([map_to_tuple_keys/1]). -export([port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). @@ -181,3 +182,11 @@ binary_to_term(_Binary, _Opts) -> cmp_term(_A,_B) -> erlang:nif_error(undefined). + +%% return the internal key tuple for map keys +-spec map_to_tuple_keys(M) -> Keys when + M :: map(), + Keys :: tuple(). + +map_to_tuple_keys(_M) -> + erlang:nif_error(undefined). diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 0653ce4c00..77297de0f3 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -665,11 +665,11 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> {value,E,Bs1} = expr(E0, Bs0, Ieval), case E of #{} -> - {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval), + {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval), Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, E, Fs), - {value,Value,Bs2}; + {value,Value,merge_bindings(Bs2, Bs1, Ieval)}; _ -> exception(error, {badarg,E}, Bs1, Ieval) end; diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index ecbd68ab40..9d7ef238e3 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -294,6 +294,7 @@ stacktrace(Config) when is_list(Config) -> maps(Config) when is_list(Config) -> Fun = fun () -> ?IM:empty_map_update([camembert]) end, {'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun), + [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end), ok. diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index e047a33d8c..7f55360f48 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -29,7 +29,7 @@ -export([more_catch/1,more_nocatch/1,exit_me/0]). -export([f/1, f_try/1, f_catch/1]). -export([otp_5837/1, otp_8310/0]). --export([empty_map_update/1]). +-export([empty_map_update/1, update_in_fun/0]). %% Internal exports. -export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]). @@ -244,3 +244,6 @@ otp_8310() -> ok. empty_map_update(Map) -> Map#{}. + +update_in_fun() -> + lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]). diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 283031eb9a..1d2dfc7b2d 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -752,14 +752,7 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> t_from_forms_without_remote([{FType, []}], RecDict) -> Type0 = erl_types:t_from_form(FType, RecDict), - Map = - fun(Type) -> - case erl_types:t_is_remote(Type) of - true -> erl_types:t_none(); - false -> Type - end - end, - {ok, erl_types:t_map(Map, Type0)}; + {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())}; t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> %% 'When' constraints unsupported; diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl new file mode 100644 index 0000000000..c34fa1b9dd --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl @@ -0,0 +1,11 @@ +-module(remote_field). + +-type f(T) :: {ssl:sslsocket(), T}. + +-record(r1, { f1 :: f(_) }). +-type r1(T) :: #r1{ f1 :: fun((ssl:sslsocket(), T) -> any()) }. + +-record(state, { + r :: r1(T), + arg :: T + }). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 6065b79664..06c0d10296 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -209,6 +209,7 @@ type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, + subst_all_remote/2, lift_list_to_pos_empty/1, is_opaque_type/2, is_erl_type/1, @@ -3161,6 +3162,18 @@ t_subst_aux(?union(List), VarMap) -> t_subst_aux(T, _VarMap) -> T. +-spec subst_all_remote(erl_type(), erl_type()) -> erl_type(). + +subst_all_remote(Type0, Substitute) -> + Map = + fun(Type) -> + case erl_types:t_is_remote(Type) of + true -> Substitute; + false -> Type + end + end, + erl_types:t_map(Map, Type0). + %%----------------------------------------------------------------------------- %% Unification %% @@ -4474,7 +4487,7 @@ get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> ModTypeNoVars = subst_all_vars_to_any(ModType), case - t_is_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType) + contains_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType) of false -> {error, FieldName}; true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) @@ -4488,6 +4501,10 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. +contains_remote(Type) -> + TypeNoRemote = subst_all_remote(Type, t_none()), + not t_is_equal(Type, TypeNoRemote). + fields_from_form([], _TypeNames, _RecDict, _VarDict) -> {[], []}; fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 4a48a5c3d8..50e1cc290c 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -361,7 +361,7 @@ fe80::204:acff:fe17:bf38 </item> <tag><c>send_dvi</c></tag> <item> - <p>Average packet size deviation in bytes received sent from the socket.</p> + <p>Average packet size deviation in bytes sent from the socket.</p> </item> <tag><c>send_max</c></tag> <item> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index f7a815882b..ef605d0bfe 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -182,6 +182,11 @@ size(Tuple, Seen0, Sum0) when is_tuple(Tuple) -> Sum = Sum0 + 1 + tuple_size(Tuple), tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum) end; +size(Map, Seen0, Sum) when is_map(Map) -> + case remember_term(Map, Seen0) of + seen -> {Sum,Seen0}; + Seen -> map_size(Map, Seen, Sum) + end; size(Fun, Seen0, Sum) when is_function(Fun) -> case remember_term(Fun, Seen0) of seen -> {Sum,Seen0}; @@ -203,6 +208,12 @@ tuple_size(I, Sz, Tuple, Seen0, Sum0) -> {Sum,Seen} = size(element(I, Tuple), Seen0, Sum0), tuple_size(I+1, Sz, Tuple, Seen, Sum). +map_size(Map,Seen0,Sum0) -> + Kt = erts_internal:map_to_tuple_keys(Map), + Vs = maps:values(Map), + {Sum1,Seen1} = size(Kt,Seen0,Sum0), + fold_size(Vs,Seen1,Sum1+length(Vs)+3). + fun_size(Fun, Seen, Sum) -> case erlang:fun_info(Fun, type) of {type,external} -> @@ -210,14 +221,14 @@ fun_size(Fun, Seen, Sum) -> {type,local} -> Sz = erts_debug:flat_size(fun() -> ok end), {env,Env} = erlang:fun_info(Fun, env), - fun_size_1(Env, Seen, Sum+Sz+length(Env)) + fold_size(Env, Seen, Sum+Sz+length(Env)) end. -fun_size_1([H|T], Seen0, Sum0) -> +fold_size([H|T], Seen0, Sum0) -> {Sum,Seen} = size(H, Seen0, Sum0), - fun_size_1(T, Seen, Sum); -fun_size_1([], Seen, Sum) -> {Sum,Seen}. - + fold_size(T, Seen, Sum); +fold_size([], Seen, Sum) -> {Sum,Seen}. + remember_term(Term, Seen) -> case gb_trees:lookup(Term, Seen) of none -> gb_trees:insert(Term, [Term], Seen); diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 131b615277..7c4c8ec2cc 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -66,6 +66,7 @@ MODULES= \ ssl_session \ ssl_session_cache \ ssl_socket \ + ssl_listen_tracker_sup \ tls_record \ dtls_record \ ssl_record \ diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 99839f6149..36681e2897 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -28,6 +28,7 @@ ssl_srp_primes, ssl_alert, ssl_socket, + ssl_listen_tracker_sup, %% Erlang Distribution over SSL/TLS inet_tls_dist, ssl_tls_dist_proxy, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 4dea977fe1..234db21443 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -97,17 +97,17 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), + EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), try handle_options(SslOptions0 ++ SocketValues, client) of {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}} -> - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), case ssl_socket:peername(Transport, Socket) of {ok, {Address, Port}} -> ssl_connection:connect(ConnectionCb, Address, Port, Socket, - {SslOptions, EmOpts}, + {SslOptions, emulated_socket_options(EmOpts, #socket_options{})}, self(), CbInfo, Timeout); {error, Error} -> {error, Error} @@ -141,10 +141,13 @@ listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), ConnectionCb = connection_cb(Options0), - #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb} = Config, + #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, + ssl = SslOpts, emulated = EmOpts} = Config, case Transport:listen(Port, Options) of {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}}}; + ok = ssl_socket:setopts(Transport, ListenSocket, ssl_socket:internal_inet_values()), + {ok, Tracker} = ssl_socket:inherit_tracker(ListenSocket, EmOpts, SslOpts), + {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}}; Err = {error, _} -> Err end @@ -164,21 +167,16 @@ transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). transport_accept(#sslsocket{pid = {ListenSocket, - #config{transport_info = CbInfo, + #config{transport_info = {Transport,_,_, _} =CbInfo, connection_cb = ConnectionCb, - ssl = SslOpts}}}, Timeout) -> - %% The setopt could have been invoked on the listen socket - %% and options should be inherited. - EmOptions = emulated_options(), - {Transport,_,_, _} = CbInfo, - {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), - ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), + ssl = SslOpts, + emulated = Tracker}}}, Timeout) -> case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> - ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), + {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), {ok, Port} = ssl_socket:port(Transport, Socket), ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, socket_options(SocketValues)}, self(), CbInfo], + {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, self(), CbInfo], ConnectionSup = connection_sup(ConnectionCb), case ConnectionSup:start_child(ConnArgs) of {ok, Pid} -> @@ -223,16 +221,16 @@ ssl_accept(#sslsocket{} = Socket, SslOptions, Timeout) -> ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), + EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), try handle_options(SslOptions ++ SocketValues, server) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), {ok, Port} = ssl_socket:port(Transport, Socket), ssl_connection:ssl_accept(ConnetionCb, Port, Socket, - {SslOpts, EmOpts}, - self(), CbInfo, Timeout) + {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, + self(), CbInfo, Timeout) catch Error = {error, _Reason} -> Error end. @@ -367,7 +365,7 @@ cipher_suites(all) -> %%-------------------------------------------------------------------- getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, +getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> @@ -375,8 +373,8 @@ getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_ {error, InetError} -> {error, {options, {socket_options, OptionTags, InetError}}} catch - _:_ -> - {error, {options, {socket_options, OptionTags}}} + _:Error -> + {error, {options, {socket_options, OptionTags, Error}}} end; getopts(#sslsocket{}, OptionTags) -> {error, {options, {socket_options, OptionTags}}}. @@ -396,7 +394,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try ssl_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -547,7 +545,8 @@ do_connect(Address, Port, {Transport, _, _, _} = CbInfo, try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> - ssl_connection:connect(ConnetionCb, Address, Port, Socket, {SslOpts,EmOpts}, + ssl_connection:connect(ConnetionCb, Address, Port, Socket, + {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, self(), CbInfo, Timeout); {error, Reason} -> {error, Reason} @@ -901,40 +900,24 @@ ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> %% some trusted certs. ca_cert_default(verify_peer, undefined, _) -> "". - -emulated_options() -> - [mode, packet, active, header, packet_size]. - -internal_inet_values() -> - [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - -socket_options(InetValues) -> - #socket_options{ - mode = proplists:get_value(mode, InetValues, lists), - header = proplists:get_value(header, InetValues, 0), - active = proplists:get_value(active, InetValues, active), - packet = proplists:get_value(packet, InetValues, 0), - packet_size = proplists:get_value(packet_size, InetValues) - }. - emulated_options(Opts) -> - emulated_options(Opts, internal_inet_values(), #socket_options{}). - -emulated_options([{mode,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(mode,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt}); -emulated_options([{header,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(header,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{header=Opt}); -emulated_options([{active,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(active,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{active=Opt}); -emulated_options([{packet,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt}); -emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet_size,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt}); + emulated_options(Opts, ssl_socket:internal_inet_values(), ssl_socket:default_inet_values()). + +emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(mode, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]); +emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(header, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]); +emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(active, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]); +emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(packet, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]); +emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(packet_size, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]); emulated_options([Opt|Opts], Inet, Emulated) -> emulated_options(Opts, [Opt|Inet], Emulated); emulated_options([], Inet,Emulated) -> @@ -1073,3 +1056,17 @@ assert_proplist([inet6 | Rest]) -> assert_proplist(Rest); assert_proplist([Value | _]) -> throw({option_not_a_key_value_tuple, Value}). + +emulated_socket_options(InetValues, #socket_options{ + mode = Mode, + header = Header, + active = Active, + packet = Packet, + packet_size = Size}) -> + #socket_options{ + mode = proplists:get_value(mode, InetValues, Mode), + header = proplists:get_value(header, InetValues, Header), + active = proplists:get_value(active, InetValues, Active), + packet = proplists:get_value(packet, InetValues, Packet), + packet_size = proplists:get_value(packet_size, InetValues, Size) + }. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 1eda926bcb..f681204de6 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -602,7 +602,7 @@ cipher(#finished{verify_data = Data} = Finished, cipher(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), - Connection:next_state(cipher, cipher, Record, State); + Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); cipher(timeout, State, _) -> {next_state, cipher, State, hibernate}; diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index 22614a2d34..58efeaf892 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.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 @@ -45,9 +45,11 @@ start_link() -> init([]) -> SessionCertManager = session_and_cert_manager_child_spec(), ConnetionManager = connection_manager_child_spec(), + ListenOptionsTracker = listen_options_tracker_child_spec(), ProxyServer = proxy_server_child_spec(), - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ListenOptionsTracker, ProxyServer]}}. %%-------------------------------------------------------------------- @@ -68,7 +70,7 @@ connection_manager_child_spec() -> StartFunc = {tls_connection_sup, start_link_dist, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_connection], + Modules = [tls_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -81,3 +83,11 @@ proxy_server_child_spec() -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. +listen_options_tracker_child_spec() -> + Name = ssl_socket_dist, + StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8bf5b30a83..fd0d87bd5f 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -116,14 +116,6 @@ honor_cipher_order = false }). --record(config, {ssl, %% SSL parameters - inet_user, %% User set inet options - emulated, %% #socket_option{} emulated - inet_ssl, %% inet options for internal ssl socket - transport_info, %% Callback info - connection_cb - }). - -record(socket_options, { mode = list, @@ -133,6 +125,15 @@ active = true }). +-record(config, {ssl, %% SSL parameters + inet_user, %% User set inet options + emulated, %% Emulated option list or "inherit_tracker" pid + inet_ssl, %% inet options for internal ssl socket + transport_info, %% Callback info + connection_cb + }). + + -type state_name() :: hello | abbreviated | certify | cipher | connection. -type gen_fsm_state_return() :: {next_state, state_name(), term()} | {next_state, state_name(), term(), timeout()} | diff --git a/lib/ssl/src/ssl_listen_tracker_sup.erl b/lib/ssl/src/ssl_listen_tracker_sup.erl new file mode 100644 index 0000000000..29f40e846d --- /dev/null +++ b/lib/ssl/src/ssl_listen_tracker_sup.erl @@ -0,0 +1,71 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Supervisor for a listen options tracker +%%---------------------------------------------------------------------- +-module(ssl_listen_tracker_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link() -> + supervisor:start_link({local, tracker_name(normal)}, ?MODULE, []). + +start_link_dist() -> + supervisor:start_link({local, tracker_name(dist)}, ?MODULE, []). + +start_child(Args) -> + supervisor:start_child(tracker_name(normal), Args). + +start_child_dist(Args) -> + supervisor:start_child(tracker_name(dist), Args). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(_O) -> + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {ssl_socket, start_link, []}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [ssl_socket], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. + +tracker_name(normal) -> + ?MODULE; +tracker_name(dist) -> + list_to_atom(atom_to_list(?MODULE) ++ "dist"). diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl index 1b6e637cd3..8532788ffd 100644 --- a/lib/ssl/src/ssl_socket.erl +++ b/lib/ssl/src/ssl_socket.erl @@ -1,20 +1,72 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% -module(ssl_socket). +-behaviour(gen_server). + -include("ssl_internal.hrl"). -include("ssl_api.hrl"). -export([socket/4, setopts/3, getopts/3, peername/2, sockname/2, port/2]). +-export([emulated_options/0, internal_inet_values/0, default_inet_values/0, + init/1, start_link/2, terminate/2, inherit_tracker/3, get_emulated_opts/1, + set_emulated_opts/2, handle_call/3, handle_cast/2, + handle_info/2, code_change/3]). + +-record(state, { + emulated_opts, + port + }). +%%-------------------------------------------------------------------- +%%% Internal API +%%-------------------------------------------------------------------- socket(Pid, Transport, Socket, ConnectionCb) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility fd = {Transport, Socket, ConnectionCb}}. - +setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOpts, EmulatedOpts} = split_options(Options), + ok = set_emulated_opts(Tracker, EmulatedOpts), + inet:setopts(ListenSocket, SockOpts); +setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}, + emulated = Tracker}}}, Options) -> + {SockOpts, EmulatedOpts} = split_options(Options), + ok = set_emulated_opts(Tracker, EmulatedOpts), + Transport:setopts(ListenSocket, SockOpts); +%%% Following clauses will not be called for emulated options, they are handled in the connection process setopts(gen_tcp, Socket, Options) -> inet:setopts(Socket, Options); setopts(Transport, Socket, Options) -> Transport:setopts(Socket, Options). +getopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOptNames, EmulatedOptNames} = split_options(Options), + EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames), + SocketOpts = get_socket_opts(ListenSocket, SockOptNames, inet), + {ok, EmulatedOpts ++ SocketOpts}; +getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOptNames, EmulatedOptNames} = split_options(Options), + EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames), + SocketOpts = get_socket_opts(ListenSocket, SockOptNames, Transport), + {ok, EmulatedOpts ++ SocketOpts}; +%%% Following clauses will not be called for emulated options, they are handled in the connection process getopts(gen_tcp, Socket, Options) -> inet:getopts(Socket, Options); getopts(Transport, Socket, Options) -> @@ -34,3 +86,145 @@ port(gen_tcp, Socket) -> inet:port(Socket); port(Transport, Socket) -> Transport:port(Socket). + +emulated_options() -> + [mode, packet, active, header, packet_size]. + +internal_inet_values() -> + [{packet_size,0}, {packet, 0}, {header, 0}, {active, false}, {mode,binary}]. + +default_inet_values() -> + [{packet_size, 0}, {packet,0}, {header, 0}, {active, true}, {mode, list}]. + +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false}) -> + ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts]); +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true}) -> + ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts]). + +get_emulated_opts(TrackerPid, EmOptNames) -> + {ok, EmOpts} = get_emulated_opts(TrackerPid), + lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), + Value end, + EmOptNames). + +get_emulated_opts(TrackerPid) -> + call(TrackerPid, get_emulated_opts). +set_emulated_opts(TrackerPid, InetValues) -> + call(TrackerPid, {set_emulated_opts, InetValues}). + +%%==================================================================== +%% ssl_listen_tracker_sup API +%%==================================================================== + +start_link(Port, SockOpts) -> + gen_server:start_link(?MODULE, [Port, SockOpts], []). + +%%-------------------------------------------------------------------- +-spec init(list()) -> {ok, #state{}}. +%% Possible return values not used now. +%% | {ok, #state{}, timeout()} | ignore | {stop, term()}. +%% +%% Description: Initiates the server +%%-------------------------------------------------------------------- +init([Port, Opts]) -> + process_flag(trap_exit, true), + true = link(Port), + {ok, #state{emulated_opts = Opts, port = Port}}. + +%%-------------------------------------------------------------------- +-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. +%% Possible return values not used now. +%% {reply, reply(), #state{}, timeout()} | +%% {noreply, #state{}} | +%% {noreply, #state{}, timeout()} | +%% {stop, reason(), reply(), #state{}} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call({set_emulated_opts, Opts0}, _From, + #state{emulated_opts = Opts1} = State) -> + Opts = do_set_emulated_opts(Opts0, Opts1), + {reply, ok, State#state{emulated_opts = Opts}}; +handle_call(get_emulated_opts, _From, + #state{emulated_opts = Opts} = State) -> + {reply, {ok, Opts}, State}. + +%%-------------------------------------------------------------------- +-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% | {noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(_, State)-> + {noreply, State}. + +%%-------------------------------------------------------------------- +-spec handle_info(msg(), #state{}) -> {stop, reason(), #state{}}. +%% Possible return values not used now. +%% {noreply, #state{}}. +%% |{noreply, #state{}, timeout()} | +%% +%% +%% Description: Handling all non call/cast messages +%%------------------------------------------------------------------- +handle_info({'EXIT', Port, _}, #state{port = Port} = State) -> + {stop, normal, State}. + + +%%-------------------------------------------------------------------- +-spec terminate(reason(), #state{}) -> ok. +%% +%% Description: This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any necessary +%% cleaning up. When it returns, the gen_server terminates with Reason. +%% The return value is ignored. +%%-------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +-spec code_change(term(), #state{}, list()) -> {ok, #state{}}. +%% +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +call(Pid, Msg) -> + gen_server:call(Pid, Msg, infinity). + +split_options(Opts) -> + split_options(Opts, emulated_options(), [], []). +split_options([], _, SocketOpts, EmuOpts) -> + {SocketOpts, EmuOpts}; +split_options([{Name, _} = Opt | Opts], Emu, SocketOpts, EmuOpts) -> + case lists:member(Name, Emu) of + true -> + split_options(Opts, Emu, SocketOpts, [Opt | EmuOpts]); + false -> + split_options(Opts, Emu, [Opt | SocketOpts], EmuOpts) + end; +split_options([Name | Opts], Emu, SocketOptNames, EmuOptNames) -> + case lists:member(Name, Emu) of + true -> + split_options(Opts, Emu, SocketOptNames, [Name | EmuOptNames]); + false -> + split_options(Opts, Emu, [Name | SocketOptNames], EmuOptNames) + end. + +do_set_emulated_opts([], Opts) -> + Opts; +do_set_emulated_opts([{Name,_} = Opt | Rest], Opts) -> + do_set_emulated_opts(Rest, [Opt | proplists:delete(Name, Opts)]). + +get_socket_opts(_, [], _) -> + []; +get_socket_opts(ListenSocket, SockOptNames, Cb) -> + {ok, Opts} = Cb:getopts(ListenSocket, SockOptNames), + Opts. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index e1aeb11ca4..7cccf8d5a5 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -47,8 +47,10 @@ init([]) -> TLSConnetionManager = tls_connection_manager_child_spec(), %% Not supported yet %%DTLSConnetionManager = tls_connection_manager_child_spec(), - - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager]}}. + %% Handles emulated options so that they inherited by the accept socket, even when setopts is performed on + %% the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, ListenOptionsTracker]}}. manager_opts() -> @@ -85,7 +87,7 @@ tls_connection_manager_child_spec() -> StartFunc = {tls_connection_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [tls_connection, ssl_connection], + Modules = [tls_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -98,6 +100,17 @@ tls_connection_manager_child_spec() -> %% Type = supervisor, %% {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = ssl_socket, + StartFunc = {ssl_listen_tracker_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + + session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/tls_connection_sup.erl b/lib/ssl/src/tls_connection_sup.erl index 6f0d8a7262..7a637c212a 100644 --- a/lib/ssl/src/tls_connection_sup.erl +++ b/lib/ssl/src/tls_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -59,7 +59,7 @@ init(_O) -> StartFunc = {tls_connection, start_link, []}, Restart = temporary, % E.g. should not be restarted Shutdown = 4000, - Modules = [tls_connection], + Modules = [tls_connection, ssl_connection], Type = worker, ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 9cae0e9468..a1b766e05f 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -141,7 +141,8 @@ api_tests() -> ssl_accept_timeout, ssl_recv_timeout, versions_option, - server_name_indication_option + server_name_indication_option, + accept_pool ]. session_tests() -> @@ -3186,6 +3187,53 @@ server_name_indication_option(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client0), ssl_test_lib:close(Client1). +%%-------------------------------------------------------------------- + +accept_pool() -> + [{doc,"Test having an accept pool."}]. +accept_pool(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server0 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {accepters, 3}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server0), + [Server1, Server2] = ssl_test_lib:accepters(2), + + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + ssl_test_lib:check_ok([Server0, Server1, Server2, Client0, Client1, Client2]), + + ssl_test_lib:close(Server0), + ssl_test_lib:close(Server1), + ssl_test_lib:close(Server2), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1), + ssl_test_lib:close(Client2). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 59f10d53a6..69b222fc43 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -67,7 +67,16 @@ run_server(Opts) -> run_server(ListenSocket, Opts). run_server(ListenSocket, Opts) -> - do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts). + Accepters = proplists:get_value(accepters, Opts, 1), + run_server(ListenSocket, Opts, Accepters). + +run_server(ListenSocket, Opts, 1) -> + do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts); +run_server(ListenSocket, Opts, N) -> + Pid = proplists:get_value(from, Opts), + Server = spawn(?MODULE, run_server, [ListenSocket, Opts, 1]), + Pid ! {accepter, N, Server}, + run_server(ListenSocket, Opts, N-1). do_run_server(_, {error, timeout} = Result, Opts) -> Pid = proplists:get_value(from, Opts), @@ -290,7 +299,16 @@ wait_for_result(Server, ServerMsg, Client, ClientMsg) -> %% Unexpected end. - +check_ok([]) -> + ok; +check_ok(Pids) -> + receive + {Pid, ok} -> + check_ok(lists:delete(Pid, Pids)); + Other -> + ct:fail({expected, {"pid()", ok}, got, Other}) + end. + wait_for_result(Pid, Msg) -> receive {Pid, Msg} -> @@ -679,6 +697,17 @@ run_client_error(Opts) -> Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), Pid ! {self(), Error}. +accepters(N) -> + accepters([], N). + +accepters(Acc, 0) -> + Acc; +accepters(Acc, N) -> + receive + {accepter, _, Server} -> + accepters([Server| Acc], N-1) + end. + inet_port(Pid) when is_pid(Pid)-> receive {Pid, {port, Port}} -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index acde3ad5d6..3cfedfee97 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -244,17 +244,17 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); %% map -expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) -> - {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs), +expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> + {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none), case Map0 of #{} -> - {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef), + {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef), Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K, V, Mi); ({map_exact,K,V}, Mi) -> maps:update(K, V, Mi) end, Map0, Vs), - ret_expr(Map1, Bs, RBs); + ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs); _ -> erlang:raise(error, {badarg,Map0}, stacktrace()) end; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 1dc5fc52a7..e1ae3b7aea 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -848,10 +848,12 @@ build_fun(Line, Cs) -> end. check_clauses(Cs, Name, Arity) -> - mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity -> - {clause,L,As,G,B}; - ({clause,L,_N,_As,_G,_B}) -> - ret_err(L, "head mismatch") end, Cs). + [case C of + {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity -> + {clause,L,As,G,B}; + {clause,L,_N,_As,_G,_B} -> + ret_err(L, "head mismatch") + end || C <- Cs]. build_try(L,Es,Scs,{Ccs,As}) -> {'try',L,Es,Scs,Ccs,As}. @@ -861,17 +863,6 @@ ret_err(L, S) -> {location,Location} = get_attribute(L, location), return_error(Location, S). -%% mapl(F,List) -%% an alternative map which always maps from left to right -%% and makes it possible to interrupt the mapping with throw on -%% the first occurence from left as expected. -%% can be removed when the jam machine (and all other machines) -%% uses the standardized (Erlang 5.0) evaluation order (from left to right) -mapl(F, [H|T]) -> - V = F(H), - [V | mapl(F,T)]; -mapl(_, []) -> - []. %% Convert between the abstract form of a term and a term. diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b91d14b5b8..b55324161b 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1451,6 +1451,13 @@ eep43(Config) when is_list(Config) -> " {Map#{a := B},Map#{a => c},Map#{d => e}} " "end.", {#{a => b},#{a => c},#{a => b,d => e}}), + check(fun () -> + lists:map(fun (X) -> X#{price := 0} end, + [#{hello => 0, price => nil}]) + end, + "lists:map(fun (X) -> X#{price := 0} end, + [#{hello => 0, price => nil}]).", + [#{hello => 0, price => 0}]), error_check("[camembert]#{}.", {badarg,[camembert]}), error_check("#{} = 1.", {badmatch,1}), ok. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index c9996c954e..46a5ca48df 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -2071,7 +2071,7 @@ map_field_assoc_value(Node) -> {map_field_assoc, _, _, Value} -> Value; _ -> - (data(Node))#map_field_assoc.name + (data(Node))#map_field_assoc.value end. @@ -2129,7 +2129,7 @@ map_field_exact_value(Node) -> {map_field_exact, _, _, Value} -> Value; _ -> - (data(Node))#map_field_exact.name + (data(Node))#map_field_exact.value end. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index d4c54a72aa..6fb3e5ccfb 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,12 +24,12 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([app_test/1,appup_test/1,smoke_test/1,revert/1]). +-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test,appup_test,smoke_test,revert]. + [app_test,appup_test,smoke_test,revert,revert_map]. groups() -> []. @@ -109,6 +109,16 @@ revert_file(File, Path) -> ok end. +%% Testing bug fix for reverting map_field_assoc +revert_map(Config) -> + Dog = ?t:timetrap(?t:minutes(1)), + ?line [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] = + erl_syntax:revert_forms([{tree,map_field_assoc, + {attr,16,[],none}, + {map_field_assoc, + {atom,17,name},{var,18,'Value'}}}]), + ?line ?t:timetrap_cancel(Dog). + p_run(Test, List) -> N = erlang:system_info(schedulers), p_run_loop(Test, List, N, [], 0). diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 37208710fe..0ca425da86 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -792,6 +792,244 @@ Expr1 -- Expr2</pre> </section> <section> + <title>Map Expressions</title> + <section> + <title>Creating Maps</title> + <p> + Constructing a new map is done by letting an expression <c>K</c> be associated with + another expression <c>V</c>: + </p> + <code>#{ K => V }</code> + <p> + New maps may include multiple associations at construction by listing every + association: + </p> + <code>#{ K1 => V1, .., Kn => Vn }</code> + <p> + An empty map is constructed by not associating any terms with each other: + </p> + <code>#{}</code> + <p> + All keys and values in the map are terms. Any expression is first evaluated and + then the resulting terms are used as <em>key</em> and <em>value</em> respectively. + </p> + <p> + Keys and values are separated by the <c>=></c> arrow and associations are + separated by <c>,</c>. + </p> + + <p> + Examples: + </p> + <code> +M0 = #{}, % empty map +M1 = #{a => <<"hello">>}, % single association with literals +M2 = #{1 => 2, b => b}, % multiple associations with literals +M3 = #{k => {A,B}}, % single association with variables +M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> + <p> + where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> + are the resulting map terms. + </p> + <p> + If two matching keys are declared, the latter key will take precedence. + </p> + <p> + Example: + </p> + +<pre> +1> <input>#{1 => a, 1 => b}.</input> +#{1 => b } +2> <input>#{1.0 => a, 1 => b}.</input> +#{1 => b, 1.0 => a} +</pre> + <p> + The order in which the expressions constructing the keys and their + associated values are evaluated is not defined. The syntactic order of + the key-value pairs in the construction is of no relevance, except in + the above mentioned case of two matching keys. + </p> + </section> + + <section> + <title>Updating Maps</title> + <p> + Updating a map has similar syntax as constructing it. + </p> + <p> + An expression defining the map to be updated is put in front of the expression + defining the keys to be updated and their respective values. + </p> + <code>M#{ K => V }</code> + <p> + where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. + </p> + <p> + If key <c>K</c> does not match any existing key in the map, a new association + will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches + an existing key in map <c>M</c> its associated value will be replaced by the + new value <c>V</c>. In both cases the evaluated map expression will return a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + To only update an existing value, the following syntax is used, + </p> + <code>M#{ K := V } </code> + <p> + where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> + is an expression which evaluates to an existing key in <c>M</c>. + </p> + <p> + If key <c>K</c> does not match any existing keys in map <c>M</c> an exception + of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> + is present in map <c>M</c> its associated value will be replaced by the new + value <c>V</c> and the evaluated map expression returns a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + Examples: + </p> + <code> +M0 = #{}, +M1 = M0#{a => 0}, +M2 = M1#{a => 1, b => 2}, +M3 = M2#{"function" => fun() -> f() end}, +M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> + <p> + where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. + </p> + <p> + More Examples: + </p> +<pre> +1> <input>M = #{1 => a}.</input> +#{1 => a } +2> <input>M#{1.0 => b}.</input> +#{1 => a, 1.0 => b}. +3> <input>M#{1 := b}.</input> +#{1 => b} +4> <input>M#{1.0 := b}.</input> +** exception error: bad argument +</pre> + <p> + As in construction, the order in which the key and value expressions + are evaluated is not defined. The + syntactic order of the key-value pairs in the update is of no + relevance, except in the case where two keys match, in which + case the latter value is used. + </p> + </section> + + <section> + <title>Maps in Patterns</title> + <p> + Matching of key-value associations from maps is done in the following way: + </p> + + <code>#{ K := V } = M</code> + <p> + where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound + variables or a literals, and <c>V</c> can be any pattern with either bound or + unbound variables. + </p> + <p> + If the variable <c>V</c> is unbound, it will be bound to the value associated + with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable + <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. + </p> + <p> Example: </p> +<code> +1> <input>M = #{"tuple" => {1,2}}.</input> +#{"tuple" => {1,2}} +2> <input>#{"tuple" := {1,B}} = M.</input> +#{"tuple" => {1,2}} +3> <input>B.</input> +2.</code> + <p> + This will bind variable <c>B</c> to integer <c>2</c>. + </p> + <p> + Similarly, multiple values from the map may be matched: + </p> + <code>#{ K1 := V1, .., Kn := Vn } = M</code> + <p> + where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all + keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the + associated values of their respective keys. + </p> + <p> + If the matching conditions are not met, the match will fail, either with + </p> + <list> + <item> + a <c>badmatch</c> exception, if used in the context of the matching operator + as in the example, + </item> + <item> + or resulting in the next clause being tested in function heads and + case expressions. + </item> + </list> + <p> + Matching in maps only allows for <c>:=</c> as delimiters of associations. + The order in which keys are declared in matching has no relevance. + </p> + <p> + Duplicate keys are allowed in matching and will match each pattern associated + to the keys. + </p> + <code>#{ K := V1, K := V2 } = M</code> + <p> + Matching an expression against an empty map literal will match its type but + no variables will be bound: + </p> + <code>#{} = Expr</code> + <p> + This expression will match if the expression <c>Expr</c> is of type map, otherwise + it will fail with an exception <c>badmatch</c>. + </p> + <section> + <title>Matching syntax: Example with literals in function heads</title> + <p> + Matching of literals as keys are allowed in function heads. + </p> + <code> +%% only start if not_started +handle_call(start, From, #{ state := not_started } = S) -> +... + {reply, ok, S#{ state := start }}; + +%% only change if started +handle_call(change, From, #{ state := start } = S) -> +... + {reply, ok, S#{ state := changed }};</code> + </section> + </section> + <section> + <title>Maps in Guards</title> + <p> + Maps are allowed in guards as long as all sub-expressions are valid guard expressions. + </p> + <p> + Two guard BIFs handles maps: + </p> + <list> + <item> + <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> + </item> + <item> + <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> + </item> + </list> + </section> + </section> + + <section> <marker id="bit_syntax"></marker> <title>Bit Syntax Expressions</title> <code type="none"><![CDATA[<<>> diff --git a/system/doc/reference_manual/maps.xml b/system/doc/reference_manual/maps.xml deleted file mode 100644 index 78808ce4a2..0000000000 --- a/system/doc/reference_manual/maps.xml +++ /dev/null @@ -1,274 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - </legalnotice> - - <title>Maps</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>maps.xml</file> - </header> - - <note> - <p>Maps are considered experimental during OTP 17 and may be subject to change.</p> - <p>The documentation below describes it being possible to use arbitrary - expressions or variables as keys, this is <em>NOT</em> implemented in the current - version of Erlang/OTP.</p> - <p>Exceptions returns <c>badarg</c> instead of <c>badmap</c>, this will change in - the future releases.</p> - </note> - - <section> - <title>Creating Maps</title> - <p> - Constructing a new map is done by letting an expression <c>K</c> be associated with - another expression <c>V</c>: - </p> - <code>#{ K => V }</code> - <p> - New maps may include multiple associations at construction by listing every - association: - </p> - <code>#{ K1 => V1, .., Kn => Vn }</code> - <p> - An empty map is constructed by not associating any terms with each other: - </p> - <code>#{}</code> - <p> - All keys and values in the map are terms. Any expression is first evaluated and - then the resulting terms are used as <em>key</em> and <em>value</em> respectively. - </p> - <p> - Keys and values are separated by the <c>=></c> arrow and associations are - separated by <c>,</c>. - </p> - - <p> - Examples: - </p> - <code> -M0 = #{}, % empty map -M1 = #{a => <<"hello">>}, % single association with literals -M2 = #{1 => 2, b => b}, % multiple associations with literals -M3 = #{k => {A,B}}, % single association with variables -M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> - <p> - where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> - are the resulting map terms. - </p> - <p> - If two matching keys are declared, the latter key will take precedence. - </p> - <p> - Example: - </p> - -<pre> -1> <input>#{1 => a, 1 => b}.</input> -#{1 => b } -2> <input>#{1.0 => a, 1 => b}.</input> -#{1 => b, 1.0 => a} -</pre> - <p> - The order in which the expressions constructing the keys and their - associated values are evaluated is not defined. The syntactic order of - the key-value pairs in the construction is of no relevance, except in - the above mentioned case of two matching keys. - </p> - </section> - - <section> - <title>Updating Maps</title> - <p> - Updating a map has similar syntax as constructing it. - </p> - <p> - An expression defining the map to be updated is put in front of the expression - defining the keys to be updated and their respective values. - </p> - <code>M#{ K => V }</code> - <p> - where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. - </p> - <p> - If key <c>K</c> does not match any existing key in the map, a new association - will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches - an existing key in map <c>M</c> its associated value will be replaced by the - new value <c>V</c>. In both cases the evaluated map expression will return a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - To only update an existing value, the following syntax is used, - </p> - <code>M#{ K := V } </code> - <p> - where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> - is an expression which evaluates to an existing key in <c>M</c>. - </p> - <p> - If key <c>K</c> does not match any existing keys in map <c>M</c> an exception - of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> - is present in map <c>M</c> its associated value will be replaced by the new - value <c>V</c> and the evaluated map expression returns a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - Examples: - </p> - <code> -M0 = #{}, -M1 = M0#{a => 0}, -M2 = M1#{a => 1, b => 2}, -M3 = M2#{"function" => fun() -> f() end}, -M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> - <p> - where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. - </p> - <p> - More Examples: - </p> -<pre> -1> <input>M = #{1 => a}.</input> -#{1 => a } -2> <input>M#{1.0 => b}.</input> -#{1 => a, 1.0 => b}. -3> <input>M#{1 := b}.</input> -#{1 => b} -4> <input>M#{1.0 := b}.</input> -** exception error: bad argument -</pre> - <p> - As in construction, the order in which the key and value expressions - are evaluated is not defined. The - syntactic order of the key-value pairs in the update is of no - relevance, except in the case where two keys match, in which - case the latter value is used. - </p> - </section> - - <section> - <title>Maps in Patterns</title> - <p> - Matching of key-value associations from maps is done in the following way: - </p> - - <code>#{ K := V } = M</code> - <p> - where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound - variables or a literals, and <c>V</c> can be any pattern with either bound or - unbound variables. - </p> - <p> - If the variable <c>V</c> is unbound, it will be bound to the value associated - with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable - <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. - </p> - <p> Example: </p> -<code> -1> <input>M = #{"tuple" => {1,2}}.</input> -#{"tuple" => {1,2}} -2> <input>#{"tuple" := {1,B}} = M.</input> -#{"tuple" => {1,2}} -3> <input>B.</input> -2.</code> - <p> - This will bind variable <c>B</c> to integer <c>2</c>. - </p> - <p> - Similarly, multiple values from the map may be matched: - </p> - <code>#{ K1 := V1, .., Kn := Vn } = M</code> - <p> - where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all - keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the - associated values of their respective keys. - </p> - <p> - If the matching conditions are not met, the match will fail, either with - </p> - <list> - <item> - a <c>badmatch</c> exception, if used in the context of the matching operator - as in the example, - </item> - <item> - or resulting in the next clause being tested in function heads and - case expressions. - </item> - </list> - <p> - Matching in maps only allows for <c>:=</c> as delimiters of associations. - The order in which keys are declared in matching has no relevance. - </p> - <p> - Duplicate keys are allowed in matching and will match each pattern associated - to the keys. - </p> - <code>#{ K := V1, K := V2 } = M</code> - <p> - Matching an expression against an empty map literal will match its type but - no variables will be bound: - </p> - <code>#{} = Expr</code> - <p> - This expression will match if the expression <c>Expr</c> is of type map, otherwise - it will fail with an exception <c>badmatch</c>. - </p> - <section> - <title>Matching syntax: Example with literals in function heads</title> - <p> - Matching of literals as keys are allowed in function heads. - </p> - <code> -%% only start if not_started -handle_call(start, From, #{ state := not_started } = S) -> -... - {reply, ok, S#{ state := start }}; - -%% only change if started -handle_call(change, From, #{ state := start } = S) -> -... - {reply, ok, S#{ state := changed }};</code> - </section> - </section> - <section> - <title>Maps in Guards</title> - <p> - Maps are allowed in guards as long as all sub-expressions are valid guard expressions. - </p> - <p> - Two guard BIFs handles maps: - </p> - <list> - <item> - <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> - </item> - <item> - <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> - </item> - </list> - </section> -</chapter> diff --git a/system/doc/reference_manual/part.xml b/system/doc/reference_manual/part.xml index 36fb888748..ee8f3dd7eb 100644 --- a/system/doc/reference_manual/part.xml +++ b/system/doc/reference_manual/part.xml @@ -36,7 +36,6 @@ <xi:include href="typespec.xml"/> <xi:include href="expressions.xml"/> <xi:include href="macros.xml"/> - <xi:include href="maps.xml"/> <xi:include href="records.xml"/> <xi:include href="errors.xml"/> <xi:include href="processes.xml"/> diff --git a/system/doc/reference_manual/xmlfiles.mk b/system/doc/reference_manual/xmlfiles.mk index 181e6f8042..6886c8c7cf 100644 --- a/system/doc/reference_manual/xmlfiles.mk +++ b/system/doc/reference_manual/xmlfiles.mk @@ -24,7 +24,6 @@ REF_MAN_CHAPTER_FILES = \ functions.xml \ expressions.xml \ macros.xml \ - maps.xml \ records.xml \ errors.xml \ processes.xml \ |