aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/doc/src/event_handler_chapter.xml9
-rw-r--r--lib/common_test/src/ct.erl14
-rw-r--r--lib/common_test/src/ct_framework.erl68
-rw-r--r--lib/common_test/src/ct_logs.erl14
-rw-r--r--lib/common_test/src/ct_master.erl13
-rw-r--r--lib/common_test/src/ct_netconfc.erl8
-rw-r--r--lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_error_SUITE.erl3
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl10
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl18
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl2
-rw-r--r--lib/common_test/test/ct_event_handler_SUITE.erl41
-rw-r--r--lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl102
-rw-r--r--lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl34
-rw-r--r--lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl6
-rw-r--r--lib/common_test/test/ct_groups_test_1_SUITE.erl20
-rw-r--r--lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_groups_test_2_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl33
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/ns.erl7
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE.erl12
-rw-r--r--lib/common_test/test/ct_repeat_1_SUITE.erl39
-rw-r--r--lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_sequence_1_SUITE.erl21
-rw-r--r--lib/common_test/test/ct_shell_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_smoke_test_SUITE.erl10
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl12
-rw-r--r--lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_test_support.erl14
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl2
-rw-r--r--lib/common_test/test/telnet_server.erl8
-rw-r--r--lib/compiler/src/Makefile4
-rw-r--r--lib/compiler/src/beam_block.erl19
-rw-r--r--lib/compiler/src/beam_bool.erl3
-rw-r--r--lib/compiler/src/beam_dead.erl24
-rw-r--r--lib/compiler/src/beam_peep.erl15
-rw-r--r--lib/compiler/src/cerl.erl3
-rw-r--r--lib/compiler/src/sys_core_fold.erl512
-rw-r--r--lib/compiler/src/v3_codegen.erl6
-rw-r--r--lib/compiler/src/v3_core.erl87
-rw-r--r--lib/compiler/src/v3_life.erl56
-rw-r--r--lib/compiler/test/andor_SUITE.erl12
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl2
-rw-r--r--lib/compiler/test/map_SUITE.erl2
-rw-r--r--lib/compiler/test/match_SUITE.erl13
-rw-r--r--lib/compiler/test/warnings_SUITE.erl26
-rw-r--r--lib/debugger/test/map_SUITE.erl233
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl1
-rw-r--r--lib/edoc/doc/overview.edoc2
-rw-r--r--lib/edoc/src/edoc.erl10
-rw-r--r--lib/edoc/src/edoc_extract.erl6
-rw-r--r--lib/edoc/src/edoc_lib.erl12
-rw-r--r--lib/eldap/doc/src/eldap.xml2
-rw-r--r--lib/eldap/vsn.mk2
-rw-r--r--lib/hipe/rtl/hipe_tagscheme.erl21
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl31
-rw-r--r--lib/inets/src/http_client/httpc_cookie.erl4
-rw-r--r--lib/kernel/src/erl_distribution.erl1
-rw-r--r--lib/kernel/src/erts_debug.erl49
-rw-r--r--lib/kernel/test/inet_SUITE.erl26
-rw-r--r--lib/kernel/test/zlib_SUITE.erl6
-rw-r--r--lib/mnesia/test/mnesia_trans_access_test.erl6
-rw-r--r--lib/os_mon/src/cpu_sup.erl2
-rw-r--r--lib/public_key/src/public_key.erl30
-rw-r--r--lib/ssh/examples/Makefile5
-rw-r--r--lib/ssh/examples/ssh_device.erl62
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/ssl.xml56
-rw-r--r--lib/ssl/doc/src/ssl_crl_cache.xml2
-rw-r--r--lib/ssl/doc/src/ssl_crl_cache_api.xml16
-rw-r--r--lib/ssl/src/dtls_connection.erl9
-rw-r--r--lib/ssl/src/dtls_handshake.erl4
-rw-r--r--lib/ssl/src/ssl.erl47
-rw-r--r--lib/ssl/src/ssl_alert.erl2
-rw-r--r--lib/ssl/src/ssl_alert.hrl3
-rw-r--r--lib/ssl/src/ssl_api.hrl2
-rw-r--r--lib/ssl/src/ssl_certificate.erl2
-rw-r--r--lib/ssl/src/ssl_connection.erl51
-rw-r--r--lib/ssl/src/ssl_connection.hrl2
-rw-r--r--lib/ssl/src/ssl_crl.erl2
-rw-r--r--lib/ssl/src/ssl_crl_cache.erl6
-rw-r--r--lib/ssl/src/ssl_handshake.erl119
-rw-r--r--lib/ssl/src/ssl_handshake.hrl9
-rw-r--r--lib/ssl/src/ssl_internal.hrl2
-rw-r--r--lib/ssl/src/ssl_manager.erl6
-rw-r--r--lib/ssl/src/tls_connection.erl20
-rw-r--r--lib/ssl/src/tls_handshake.erl13
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/ssl_alpn_handshake_SUITE.erl414
-rw-r--r--lib/ssl/test/ssl_npn_handshake_SUITE.erl8
-rw-r--r--lib/ssl/test/ssl_test_lib.erl2
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl326
-rw-r--r--lib/stdlib/doc/src/ets.xml16
-rw-r--r--lib/stdlib/doc/src/proc_lib.xml2
-rw-r--r--lib/stdlib/doc/src/zip.xml8
-rw-r--r--lib/stdlib/src/ets.erl34
-rw-r--r--lib/stdlib/src/io_lib.erl6
-rw-r--r--lib/stdlib/src/otp_internal.erl2
-rw-r--r--lib/stdlib/src/zip.erl46
-rw-r--r--lib/stdlib/test/ets_SUITE.erl61
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl16
-rw-r--r--lib/stdlib/test/zip_SUITE.erl42
-rw-r--r--lib/test_server/src/test_server.erl75
-rw-r--r--lib/test_server/src/test_server_ctrl.erl46
-rw-r--r--lib/test_server/src/ts_install.erl53
-rw-r--r--lib/tools/emacs/erlang.el91
-rw-r--r--lib/tools/src/tags.erl9
119 files changed, 2535 insertions, 965 deletions
diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml
index 45f01c12ec..f39f391818 100644
--- a/lib/common_test/doc/src/event_handler_chapter.xml
+++ b/lib/common_test/doc/src/event_handler_chapter.xml
@@ -59,6 +59,15 @@
Event handlers plugged into this manager will receive the events from
all the test nodes as well as information from the CT Master server
itself.</p>
+
+ <p>User specific event handlers may be plugged into a Common Test event
+ manager, either by telling Common Test to install them before the test
+ run (see below), or by adding the handlers dynamically during the test
+ run by means of
+ <c>gen_event:add_handler/3</c> or <c>gen_event:add_sup_handler/3</c>.
+ In the latter scenario, the reference of the Common Test event manager is
+ required. To get it, call <c>ct:get_event_mgr_ref/0</c> or (on the CT
+ Master node) <c>ct_master:get_event_mgr_ref/0</c>.</p>
</section>
<section>
<marker id="usage"></marker>
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 85afdc7834..9d8fce2789 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -52,6 +52,7 @@
-module(ct).
-include("ct.hrl").
+-include("ct_util.hrl").
%% Command line user interface for running tests
-export([install/1, run/1, run/2, run/3,
@@ -77,6 +78,7 @@
%% Other interface functions
-export([get_status/0, abort_current_testcase/1,
+ get_event_mgr_ref/0,
encrypt_config_file/2, encrypt_config_file/3,
decrypt_config_file/2, decrypt_config_file/3]).
@@ -1005,6 +1007,18 @@ abort_current_testcase(Reason) ->
test_server_ctrl:abort_current_testcase(Reason).
%%%-----------------------------------------------------------------
+%%% @spec get_event_mgr_ref() -> EvMgrRef
+%%% EvMgrRef = atom()
+%%%
+%%% @doc <p>Call this function in order to get a reference to the
+%%% CT event manager. The reference can be used to e.g. add
+%%% a user specific event handler while tests are running.
+%%% Example:
+%%% <c>gen_event:add_handler(ct:get_event_mgr_ref(), my_ev_h, [])</c></p>
+get_event_mgr_ref() ->
+ ?CT_EVMGR_REF.
+
+%%%-----------------------------------------------------------------
%%% @spec encrypt_config_file(SrcFileName, EncryptFileName) ->
%%% ok | {error,Reason}
%%% SrcFileName = string()
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index ec525784ec..498950c9d1 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -686,18 +686,21 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
undefined ->
%% send sync notification so that event handlers may print
%% in the log file before it gets closed
- ct_event:sync_notify(#event{name=tc_done,
- node=node(),
- data={Mod,FuncSpec,
- tag_cth(FinalNotify)}}),
+ Event = #event{name=tc_done,
+ node=node(),
+ data={Mod,FuncSpec,
+ tag(FinalNotify)}},
+ ct_event:sync_notify(Event),
Result1;
Fun ->
%% send sync notification so that event handlers may print
%% in the log file before it gets closed
- ct_event:sync_notify(#event{name=tc_done,
- node=node(),
- data={Mod,FuncSpec,
- tag(FinalNotify)}}),
+ Event = #event{name=tc_done,
+ node=node(),
+ data={Mod,FuncSpec,
+ tag({'$test_server_framework_test',
+ FinalNotify})}},
+ ct_event:sync_notify(Event),
Fun(end_tc, Return)
end,
@@ -770,44 +773,37 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} |
%% {testcase_aborted,Reason} | testcase_aborted_or_killed |
-%% {'EXIT',Reason} | Other (ignored return value, e.g. 'ok')
-tag({STag,Reason}) when STag == skip; STag == skipped ->
- case Reason of
- {failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason};
- _ -> {skipped,Reason}
- end;
-tag({auto_skip,Reason}) ->
- {auto_skipped,Reason};
-tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT';
- ETag == timetrap_timeout;
- ETag == testcase_aborted ->
- {failed,E};
-tag(E = testcase_aborted_or_killed) ->
- {failed,E};
-tag(Other) ->
- Other.
-
-tag_cth({skipped,Reason={failed,{_,init_per_testcase,_}}}) ->
+%% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} |
+%% {user_timetrap_error,Reason} |
+%% Other (ignored return value, e.g. 'ok')
+tag({'$test_server_framework_test',Result}) ->
+ case tag(Result) of
+ ok -> Result;
+ Failure -> Failure
+ end;
+tag({skipped,Reason={failed,{_,init_per_testcase,_}}}) ->
{auto_skipped,Reason};
-tag_cth({STag,Reason}) when STag == skip; STag == skipped ->
+tag({STag,Reason}) when STag == skip; STag == skipped ->
case Reason of
{failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason};
_ -> {skipped,Reason}
end;
-tag_cth({auto_skip,Reason}) ->
+tag({auto_skip,Reason}) ->
{auto_skipped,Reason};
-tag_cth({fail,Reason}) ->
+tag({fail,Reason}) ->
{failed,{error,Reason}};
-tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT';
+tag(Failed = {failed,_Reason}) ->
+ Failed;
+tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT';
ETag == timetrap_timeout;
ETag == testcase_aborted ->
{failed,E};
-tag_cth(E = testcase_aborted_or_killed) ->
+tag(E = testcase_aborted_or_killed) ->
{failed,E};
-tag_cth(List) when is_list(List) ->
- ok;
-tag_cth(Other) ->
- Other.
+tag(UserTimetrap = {user_timetrap_error,_Reason}) ->
+ UserTimetrap;
+tag(_Other) ->
+ ok.
%%%-----------------------------------------------------------------
%%% @spec error_notification(Mod,Func,Args,Error) -> ok
@@ -841,6 +837,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
io_lib:format("{test_case_failed,~p}", [Reason]);
Result -> Result
end;
+ {'EXIT',_Reason} = EXIT ->
+ io_lib:format("~P", [EXIT,5]);
{Spec,_Reason} when is_atom(Spec) ->
io_lib:format("~w", [Spec]);
Other ->
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index 23332ad268..dc118ed149 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -1905,6 +1905,17 @@ sort_all_runs(Dirs) ->
{Date1,HH1,MM1,SS1} > {Date2,HH2,MM2,SS2}
end, Dirs).
+sort_ct_runs(Dirs) ->
+ %% Directory naming: <Prefix>.NodeName.Date_Time[/...]
+ %% Sort on Date_Time string: "YYYY-MM-DD_HH.MM.SS"
+ lists:sort(fun(Dir1,Dir2) ->
+ [_Prefix,_Node1,DateHH1,MM1,SS1] =
+ string:tokens(filename:dirname(Dir1),[$.]),
+ [_Prefix,_Node2,DateHH2,MM2,SS2] =
+ string:tokens(filename:dirname(Dir2),[$.]),
+ {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2}
+ end, Dirs).
+
dir_diff_all_runs(Dirs, LogCache) ->
case LogCache#log_cache.all_runs of
[] ->
@@ -2217,7 +2228,8 @@ make_all_suites_index(When) when is_atom(When) ->
end
end,
- LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext),
+ Wildcard = logdir_prefix()++".*/*"++?logdir_ext,
+ LogDirs = sort_ct_runs(filelib:wildcard(Wildcard)),
LogCacheInfo = get_cache_data(UseCache),
diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl
index b42ff73846..2cdb259899 100644
--- a/lib/common_test/src/ct_master.erl
+++ b/lib/common_test/src/ct_master.erl
@@ -25,6 +25,7 @@
-export([run/1,run/3,run/4]).
-export([run_on_node/2,run_on_node/3]).
-export([run_test/1,run_test/2]).
+-export([get_event_mgr_ref/0]).
-export([basic_html/1]).
-export([abort/0,abort/1,progress/0]).
@@ -292,6 +293,18 @@ progress() ->
call(progress).
%%%-----------------------------------------------------------------
+%%% @spec get_event_mgr_ref() -> MasterEvMgrRef
+%%% MasterEvMgrRef = atom()
+%%%
+%%% @doc <p>Call this function in order to get a reference to the
+%%% CT master event manager. The reference can be used to e.g.
+%%% add a user specific event handler while tests are running.
+%%% Example:
+%%% <c>gen_event:add_handler(ct_master:get_event_mgr_ref(), my_ev_h, [])</c></p>
+get_event_mgr_ref() ->
+ ?CT_MEVMGR_REF.
+
+%%%-----------------------------------------------------------------
%%% @spec basic_html(Bool) -> ok
%%% Bool = true | false
%%%
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index 14ee55703f..af82f2dcbf 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -794,8 +794,9 @@ action(Client,Action) ->
Client :: client(),
Action :: simple_xml(),
Timeout :: timeout(),
- Result :: {ok,[simple_xml()]} | {error,error_reason()}.
-%% @doc Execute an action.
+ Result :: ok | {ok,[simple_xml()]} | {error,error_reason()}.
+%% @doc Execute an action. If the return type is void, <c>ok</c> will
+%% be returned instead of <c>{ok,[simple_xml()]}</c>.
%%
%% @end
%%----------------------------------------------------------------------
@@ -1606,6 +1607,9 @@ decode_ok(Other) ->
decode_data([{Tag,Attrs,Content}]) ->
case get_local_name_atom(Tag) of
+ ok ->
+ %% when action has return type void
+ ok;
data ->
%% Since content of data has nothing from the netconf
%% namespace, we remove the parent's xmlns attribute here
diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
index 8ee12a2e4d..c2e06d866f 100644
--- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
+++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
@@ -73,7 +73,7 @@ test_get_known_variable(_)->
test_localtime_update(_)->
Seconds = 5,
LT1 = ct:get_config(localtime),
- timer:sleep(Seconds*1000),
+ ct:sleep(Seconds*1000),
LT2 = ct:reload_config(localtime),
case is_diff_ok(LT1, LT2, Seconds) of
{false, Actual, Exp}->
diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl
index ecf231529a..8464225284 100644
--- a/lib/common_test/test/ct_error_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE.erl
@@ -1466,7 +1466,8 @@ test_events(misc_errors) ->
{failed,{error,{suite_failed,this_is_expected}}}}},
{?eh,test_stats,{0,5,{0,0}}},
{?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_1}},
- {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1,i_die_now}},
+ {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1,
+ {failed,{'EXIT',i_die_now}}}},
{?eh,test_stats,{0,6,{0,0}}},
{?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_2}},
{?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_2,
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl
index 806d3caf72..0ff8659269 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl
@@ -26,10 +26,10 @@ init_per_testcase(_, Config) ->
Config.
end_per_testcase(tc2, _Config) ->
- timer:sleep(2000),
+ ct:sleep(2000),
exit(this_should_not_be_printed);
end_per_testcase(tc4, _Config) ->
- timer:sleep(2000),
+ ct:sleep(2000),
exit(this_should_not_be_printed);
end_per_testcase(_, _) ->
ok.
@@ -42,7 +42,7 @@ tc1() ->
put('$test_server_framework_test',
fun(init_tc, _Default) ->
ct:pal("init_tc(~p): Night time...",[self()]),
- timer:sleep(2000),
+ ct:sleep(2000),
ct:pal("init_tc(~p): Day time!",[self()]),
exit(this_should_not_be_printed);
(_, Default) -> Default
@@ -67,7 +67,7 @@ tc3(_) ->
put('$test_server_framework_test',
fun(end_tc, _Default) ->
ct:pal("end_tc(~p): Night time...",[self()]),
- timer:sleep(1000),
+ ct:sleep(1000),
ct:pal("end_tc(~p): Day time!",[self()]);
(_, Default) -> Default
end),
@@ -78,7 +78,7 @@ tc4() ->
put('$test_server_framework_test',
fun(end_tc, _Default) ->
ct:pal("end_tc(~p): Night time...",[self()]),
- timer:sleep(1000),
+ ct:sleep(1000),
ct:pal("end_tc(~p): Day time!",[self()]);
(_, Default) -> Default
end),
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl
index c8a3c1d15e..cfc0babb68 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl
@@ -26,7 +26,7 @@ init_per_suite() ->
put('$test_server_framework_test',
fun(end_tc, _Default) ->
ct:pal("end_tc(~p): Night time...",[self()]),
- timer:sleep(1000),
+ ct:sleep(1000),
ct:pal("end_tc(~p): Day time!",[self()]);
(_, Default) -> Default
end),
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl
index 960d0f61b0..54b09e78c6 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl
@@ -29,7 +29,7 @@ end_per_suite() ->
put('$test_server_framework_test',
fun(end_tc, _Default) ->
ct:pal("end_tc(~p): Night time...",[self()]),
- timer:sleep(1000),
+ ct:sleep(1000),
ct:pal("end_tc(~p): Day time!",[self()]);
(_, Default) -> Default
end),
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl
index 08c57887ef..0d93e46501 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl
@@ -36,7 +36,7 @@ suite() ->
%% Reason = term()
%%--------------------------------------------------------------------
init_per_suite(Config) ->
- timer:sleep(5000),
+ ct:sleep(5000),
exit(shouldnt_happen).
% Config.
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl
index 9cd5b6ad29..d95f3b235b 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl
@@ -43,7 +43,7 @@ init_per_suite(Config) ->
%% Config0 = Config1 = [tuple()]
%%--------------------------------------------------------------------
end_per_suite(Config) ->
- timer:sleep(5000),
+ ct:sleep(5000),
ok.
%%--------------------------------------------------------------------
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl
index 25993833d7..d8f0c48034 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl
@@ -57,7 +57,7 @@ init_per_group(g1, Config) ->
Config;
init_per_group(g2, Config) ->
ct:comment("init_per_group(g2) timeout"),
- timer:sleep(5000),
+ ct:sleep(5000),
Config;
init_per_group(g3, _Config) ->
badmatch = 42;
@@ -80,7 +80,7 @@ end_per_group(g11, _Config) ->
ok;
end_per_group(g12, _Config) ->
ct:comment("end_per_group(g6) timeout"),
- timer:sleep(5000),
+ ct:sleep(5000),
ok;
end_per_group(_GroupName, _Config) ->
ok.
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl
index a98382965f..1451a4119e 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl
@@ -111,7 +111,7 @@ end_per_testcase1(tc2, Config) ->
ct:pal("end_per_testcase(tc2): ~p", [Config]),
tc2 = ?config(tc, Config),
{failed,timetrap_timeout} = ?config(tc_status, Config),
- timer:sleep(2000);
+ ct:sleep(2000);
end_per_testcase1(tc3, Config) ->
ct:pal("end_per_testcase(tc3): ~p", [Config]),
@@ -123,7 +123,7 @@ end_per_testcase1(tc4, Config) ->
ct:pal("end_per_testcase(tc4): ~p", [Config]),
tc4 = ?config(tc, Config),
{failed,{testcase_aborted,testing_end_conf}} = ?config(tc_status, Config),
- timer:sleep(2000);
+ ct:sleep(2000);
end_per_testcase1(tc5, Config) ->
ct:pal("end_per_testcase(tc5): ~p", [Config]),
@@ -182,29 +182,29 @@ all() ->
[tc1, tc2, tc3, tc4, tc5, tc6, tc7, tc8, tc9].
tc1(_) ->
- timer:sleep(2000),
+ ct:sleep(2000),
ok.
tc2(_) ->
- timer:sleep(2000).
+ ct:sleep(2000).
tc3(_) ->
spawn(ct, abort_current_testcase, [testing_end_conf]),
- timer:sleep(2000),
+ ct:sleep(2000),
ok.
tc4(_) ->
spawn(ct, abort_current_testcase, [testing_end_conf]),
- timer:sleep(2000),
+ ct:sleep(2000),
ok.
tc5(_) ->
- timer:sleep(2000),
+ ct:sleep(2000),
ok.
tc6(_) ->
spawn(ct, abort_current_testcase, [testing_end_conf]),
- timer:sleep(2000).
+ ct:sleep(2000).
tc7(_) ->
sleep(2000),
@@ -220,5 +220,5 @@ tc9(_) ->
%%%-----------------------------------------------------------------
sleep(T) ->
- timer:sleep(T),
+ ct:sleep(T),
ok.
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl
index 1389acca11..a9ea0be847 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl
@@ -3,5 +3,5 @@
-export([sleep/1]).
sleep(T) ->
- timer:sleep(T),
+ ct:sleep(T),
ok.
diff --git a/lib/common_test/test/ct_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl
index 30a5e650fe..b759424e46 100644
--- a/lib/common_test/test/ct_event_handler_SUITE.erl
+++ b/lib/common_test/test/ct_event_handler_SUITE.erl
@@ -29,6 +29,7 @@
-compile(export_all).
-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/src/ct_util.hrl").
%-include_lib("common_test/include/ct_event.hrl").
@@ -59,7 +60,7 @@ end_per_testcase(TestCase, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [start_stop, results].
+ [start_stop, results, event_mgrs].
groups() ->
[].
@@ -156,21 +157,28 @@ results(Config) when is_list(Config) ->
TestEvents =
[{eh_A,start_logging,{'DEF','RUNDIR'}},
{eh_A,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
- {eh_A,start_info,{1,1,4}},
+ {eh_A,start_info,{1,1,5}},
{eh_A,tc_start,{eh_11_SUITE,init_per_suite}},
{eh_A,tc_done,{eh_11_SUITE,init_per_suite,ok}},
- {eh_A,tc_start,{eh_11_SUITE,tc1}},
- {eh_A,tc_done,{eh_11_SUITE,tc1,ok}},
- {eh_A,test_stats,{1,0,{0,0}}},
- {eh_A,tc_start,{eh_11_SUITE,tc2}},
- {eh_A,tc_done,{eh_11_SUITE,tc2,{skipped,"Skip"}}},
- {eh_A,test_stats,{1,0,{1,0}}},
- {eh_A,tc_start,{eh_11_SUITE,tc3}},
- {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skipped"}}},
- {eh_A,test_stats,{1,0,{2,0}}},
- {eh_A,tc_start,{eh_11_SUITE,tc4}},
- {eh_A,tc_done,{eh_11_SUITE,tc4,{failed,{error,'Failing'}}}},
- {eh_A,test_stats,{1,1,{2,0}}},
+ [{eh_A,tc_start,{eh_11_SUITE,{init_per_group,g1,[]}}},
+ {eh_A,tc_done,{eh_11_SUITE,{init_per_group,g1,[]},ok}},
+ {eh_A,tc_start,{eh_11_SUITE,tc1}},
+ {eh_A,tc_done,{eh_11_SUITE,tc1,ok}},
+ {eh_A,test_stats,{1,0,{0,0}}},
+ {eh_A,tc_start,{eh_11_SUITE,tc2}},
+ {eh_A,tc_done,{eh_11_SUITE,tc2,ok}},
+ {eh_A,test_stats,{2,0,{0,0}}},
+ {eh_A,tc_start,{eh_11_SUITE,tc3}},
+ {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skip"}}},
+ {eh_A,test_stats,{2,0,{1,0}}},
+ {eh_A,tc_start,{eh_11_SUITE,tc4}},
+ {eh_A,tc_done,{eh_11_SUITE,tc4,{skipped,"Skipped"}}},
+ {eh_A,test_stats,{2,0,{2,0}}},
+ {eh_A,tc_start,{eh_11_SUITE,tc5}},
+ {eh_A,tc_done,{eh_11_SUITE,tc5,{failed,{error,'Failing'}}}},
+ {eh_A,test_stats,{2,1,{2,0}}},
+ {eh_A,tc_start,{eh_11_SUITE,{end_per_group,g1,[]}}},
+ {eh_A,tc_done,{eh_11_SUITE,{end_per_group,g1,[]},ok}}],
{eh_A,tc_start,{eh_11_SUITE,end_per_suite}},
{eh_A,tc_done,{eh_11_SUITE,end_per_suite,ok}},
{eh_A,test_done,{'DEF','STOP_TIME'}},
@@ -179,5 +187,10 @@ results(Config) when is_list(Config) ->
ok = ct_test_support:verify_events(TestEvents++TestEvents, Events, Config).
+event_mgrs(_) ->
+ ?CT_EVMGR_REF = ct:get_event_mgr_ref(),
+ ?CT_MEVMGR_REF = ct_master:get_event_mgr_ref().
+
+
%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl
index a52fe96f30..14ea12d579 100644
--- a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl
+++ b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl
@@ -32,100 +32,36 @@
%% COMMON TEST CALLBACK FUNCTIONS
%%--------------------------------------------------------------------
-%%--------------------------------------------------------------------
-%% Function: suite() -> Info
-%%
-%% Info = [tuple()]
-%% List of key/value pairs.
-%%
-%% Description: Returns list of tuples to set default properties
-%% for the suite.
-%%
-%% Note: The suite/0 function is only meant to be used to return
-%% default data values, not perform any other operations.
-%%--------------------------------------------------------------------
suite() ->
[
{timetrap,{seconds,10}}
].
-%%--------------------------------------------------------------------
-%% Function: init_per_suite(Config0) ->
-%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
-%%
-%% Config0 = Config1 = [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%% Reason = term()
-%% The reason for skipping the suite.
-%%
-%% Description: Initialization before the suite.
-%%
-%% Note: This function is free to add any key/value pairs to the Config
-%% variable, but should NOT alter/remove any existing entries.
-%%--------------------------------------------------------------------
init_per_suite(Config) ->
Config.
-%%--------------------------------------------------------------------
-%% Function: end_per_suite(Config0) -> void() | {save_config,Config1}
-%%
-%% Config0 = Config1 = [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%%
-%% Description: Cleanup after the suite.
-%%--------------------------------------------------------------------
end_per_suite(_Config) ->
- ok.
+ %% should report ok as result to event handler
+ done.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ %% should report ok as result to event handler
+ void.
-%%--------------------------------------------------------------------
-%% Function: init_per_testcase(TestCase, Config0) ->
-%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
-%%
-%% TestCase = atom()
-%% Name of the test case that is about to run.
-%% Config0 = Config1 = [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%% Reason = term()
-%% The reason for skipping the test case.
-%%
-%% Description: Initialization before each test case.
-%%
-%% Note: This function is free to add any key/value pairs to the Config
-%% variable, but should NOT alter/remove any existing entries.
-%%--------------------------------------------------------------------
init_per_testcase(_TestCase, Config) ->
Config.
-%%--------------------------------------------------------------------
-%% Function: end_per_testcase(TestCase, Config0) ->
-%% void() | {save_config,Config1}
-%%
-%% TestCase = atom()
-%% Name of the test case that is finished.
-%% Config0 = Config1 = [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%%
-%% Description: Cleanup after each test case.
-%%--------------------------------------------------------------------
end_per_testcase(_TestCase, _Config) ->
- ok.
+ true.
-%%--------------------------------------------------------------------
-%% Function: all() -> TestCases | {skip,Reason}
-%%
-%% TestCases = [TestCase | {sequence,SeqName}]
-%% TestCase = atom()
-%% Name of a test case.
-%% SeqName = atom()
-%% Name of a test case sequence.
-%% Reason = term()
-%% The reason for skipping all test cases.
-%%
-%% Description: Returns the list of test cases that are to be executed.
-%%--------------------------------------------------------------------
-all() ->
- [tc1, tc2, tc3, tc4].
+groups() ->
+ [{g1, [], [tc1, tc2, tc3, tc4, tc5]}].
+all() ->
+ [{group,g1}].
%%--------------------------------------------------------------------
%% TEST CASES
@@ -134,11 +70,15 @@ all() ->
tc1(_Config) ->
ok.
-tc2(_Config) ->
- {skip,"Skip"}.
+tc2(_Config) ->
+ %% should report ok as result to event handler
+ 42.
tc3(_Config) ->
+ {skip,"Skip"}.
+
+tc4(_Config) ->
{skipped,"Skipped"}.
-tc4(_Config) ->
+tc5(_Config) ->
exit('Failing').
diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl
index 1344878675..96dd80e4e8 100644
--- a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl
+++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl
@@ -73,23 +73,23 @@ handles_to_multi_conn_pids(_Config) ->
{true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
ok = proto:close(Handle1),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
{true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
ok = proto:kill_conn_proc(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
{true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
ConnPid2x = ct_gen_conn:get_conn_pid(Handle2),
true = is_process_alive(ConnPid2x),
ok = proto:close(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)},
application:set_env(ct_test, reconnect, false),
ok = proto:kill_conn_proc(Handle3),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
ok.
@@ -116,23 +116,23 @@ handles_to_single_conn_pids(_Config) ->
ct:pal("CONNS = ~n~p", [Conns]),
ok = proto:close(Handle1),
- timer:sleep(100),
+ ct:sleep(100),
{false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
ok = proto:kill_conn_proc(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
NewConnPid = ct_gen_conn:get_conn_pid(Handle2),
NewConnPid = ct_gen_conn:get_conn_pid(Handle3),
true = is_process_alive(Handle2),
true = is_process_alive(Handle3),
ok = proto:close(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
{false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)},
application:set_env(ct_test, reconnect, false),
ok = proto:kill_conn_proc(Handle3),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)},
ok.
@@ -158,29 +158,29 @@ names_to_multi_conn_pids(_Config) ->
Handle1 = proto:open(mconn1),
ok = proto:close(mconn1),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)},
ok = proto:kill_conn_proc(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
Handle2 = proto:open(mconn2), % should've been reconnected already
{true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)},
ConnPid2x = ct_gen_conn:get_conn_pid(Handle2),
true = is_process_alive(ConnPid2x),
ok = proto:close(mconn2),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)},
Handle2y = proto:open(mconn2),
ConnPid2y = ct_gen_conn:get_conn_pid(Handle2y),
{true,true} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)},
ok = proto:close(mconn2),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)},
application:set_env(ct_test, reconnect, false),
ok = proto:kill_conn_proc(Handle3),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)},
ok.
@@ -211,11 +211,11 @@ names_to_single_conn_pids(_Config) ->
ct:pal("CONNS on ~p = ~n~p", [ConnPid,Conns]),
ok = proto:close(sconn1),
- timer:sleep(100),
+ ct:sleep(100),
{false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)},
ok = proto:kill_conn_proc(Handle2),
- timer:sleep(100),
+ ct:sleep(100),
{true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid)},
Handle2 = proto:open(sconn2), % should've been reconnected already
NewConnPid = ct_gen_conn:get_conn_pid(Handle2),
@@ -227,12 +227,12 @@ names_to_single_conn_pids(_Config) ->
ct:pal("CONNS on ~p = ~n~p", [NewConnPid,Conns1]),
ok = proto:close(sconn2),
- timer:sleep(100),
+ ct:sleep(100),
{false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)},
application:set_env(ct_test, reconnect, false),
ok = proto:kill_conn_proc(Handle3),
- timer:sleep(100),
+ ct:sleep(100),
{false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)},
ok.
diff --git a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl
index 804f722081..bfdc78639e 100644
--- a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl
+++ b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl
@@ -258,14 +258,14 @@ gen_io(Label, N, Acc) ->
%% (via ct logging functions) from an external process which has a
%% different group leader than the test cases.
unexp1(Config) ->
- timer:sleep(1000),
+ ct:sleep(1000),
gen_unexp_io(),
- timer:sleep(1000),
+ ct:sleep(1000),
check_unexp_io(Config),
ok.
unexp2(_) ->
- timer:sleep(2000),
+ ct:sleep(2000),
ok.
gen_unexp_io() ->
diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl
index e520a72227..d5de949554 100644
--- a/lib/common_test/test/ct_groups_test_1_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl
@@ -302,7 +302,7 @@ test_events(groups_suite_1) ->
{?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}];
@@ -410,7 +410,7 @@ test_events(groups_suite_2) ->
{?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_12_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}];
@@ -505,7 +505,7 @@ test_events(groups_suites_1) ->
{?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}},
@@ -596,7 +596,7 @@ test_events(groups_suites_1) ->
{?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_12_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}];
@@ -691,7 +691,7 @@ test_events(groups_dir_1) ->
{?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}},
@@ -782,7 +782,7 @@ test_events(groups_dir_1) ->
{?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_12_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}];
@@ -878,7 +878,7 @@ test_events(groups_dirs_1) ->
{?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}},
@@ -969,7 +969,7 @@ test_events(groups_dirs_1) ->
{?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_12_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}},
{?eh,tc_start,{groups_21_SUITE,init_per_suite}},
{?eh,tc_done,{groups_21_SUITE,init_per_suite,ok}},
@@ -1089,7 +1089,7 @@ test_events(groups_dirs_1) ->
{groups_21_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_21_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_21_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_21_SUITE,end_per_suite,ok}},
{?eh,tc_start,{groups_22_SUITE,init_per_suite}},
{?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}},
@@ -1223,6 +1223,6 @@ test_events(groups_dirs_1) ->
{groups_22_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_22_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}].
diff --git a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl
index ec90ef95d1..6f49f9a957 100644
--- a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl
@@ -278,7 +278,7 @@ testcase_5a(Config) ->
%% increase chance the done event will come
%% during execution of subgroup (could be
%% tricky to handle)
- timer:sleep(3),
+ ct:sleep(3),
ok.
testcase_5b() ->
[].
diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl
index 8b0de98709..f41395e028 100644
--- a/lib/common_test/test/ct_groups_test_2_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl
@@ -302,7 +302,7 @@ test_events(empty_group) ->
{?eh,tc_done,
{groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}],
{?eh,tc_start,{groups_22_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
].
diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
index 154c676d7e..80bb5ba69b 100644
--- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
@@ -293,7 +293,7 @@ testcase_5a(Config) ->
%% increase chance the done event will come
%% during execution of subgroup (could be
%% tricky to handle)
- timer:sleep(3),
+ ct:sleep(3),
ok.
testcase_5b() ->
[].
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
index 18dd07e87e..80ce248418 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
@@ -50,7 +50,7 @@ init_per_suite(Config) ->
end_per_suite(Config) ->
Gen = proplists:get_value(gen, Config),
exit(Gen, kill),
- timer:sleep(100),
+ ct:sleep(100),
ok.
%%--------------------------------------------------------------------
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
index 332e54d1a7..e7bbdc28a5 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
@@ -204,7 +204,7 @@ hello_required_exists(Config) ->
?NS:expect_do_reply('close-session',close,ok),
?ok = ct_netconfc:close_session(my_named_connection),
- timer:sleep(500),
+ ct:sleep(500),
%% Then check that it can be used again after the first is closed
{ok,_Client2} = open_configured_success(my_named_connection,DataDir),
@@ -486,8 +486,15 @@ action(Config) ->
DataDir = ?config(data_dir,Config),
{ok,Client} = open_success(DataDir),
Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}],
- ?NS:expect_reply(action,{data,Data}),
- {ok,Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}),
+ %% test either to receive {data,Data} or {ok,Data},
+ %% both need to be handled
+ {Reply,RetVal} = case element(3, now()) rem 2 of
+ 0 -> {{data,Data},{ok,Data}};
+ 1 -> {{ok,Data},ok}
+ end,
+ ct:log("Client will receive {~w,Data}", [element(1,Reply)]),
+ ?NS:expect_reply(action,Reply),
+ RetVal = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}),
?NS:expect_do_reply('close-session',close,ok),
?ok = ct_netconfc:close_session(Client),
ok.
@@ -654,10 +661,10 @@ receive_chunked_data(Config) ->
%% Spawn a process which will wait a bit for the client to send
%% the request (below), then order the server to the chunks of the
%% rpc-reply one by one.
- spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1),
- timer:sleep(100),?NS:hupp(send,Part2),
- timer:sleep(100),?NS:hupp(send,Part3),
- timer:sleep(100),?NS:hupp(send,Part4)
+ spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1),
+ ct:sleep(100),?NS:hupp(send,Part2),
+ ct:sleep(100),?NS:hupp(send,Part3),
+ ct:sleep(100),?NS:hupp(send,Part4)
end),
%% Order server to expect a get - then the process above will make
@@ -702,8 +709,8 @@ timeout_receive_chunked_data(Config) ->
%% Spawn a process which will wait a bit for the client to send
%% the request (below), then order the server to the chunks of the
%% rpc-reply one by one.
- spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1),
- timer:sleep(100),?NS:hupp(send,Part2)
+ spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1),
+ ct:sleep(100),?NS:hupp(send,Part2)
end),
%% Order server to expect a get - then the process above will make
@@ -748,9 +755,9 @@ close_while_waiting_for_chunked_data(Config) ->
%% Spawn a process which will wait a bit for the client to send
%% the request (below), then order the server to the chunks of the
%% rpc-reply one by one.
- spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1),
- timer:sleep(100),?NS:hupp(send,Part2),
- timer:sleep(100),?NS:hupp(kill)
+ spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1),
+ ct:sleep(100),?NS:hupp(send,Part2),
+ ct:sleep(100),?NS:hupp(kill)
end),
%% Order server to expect a get - then the process above will make
@@ -766,7 +773,7 @@ connection_crash(Config) ->
%% Test that if the test survives killing the connection
%% process. Earlier this caused ct_util_server to terminate, and
%% this aborting the complete test run.
- spawn(fun() -> timer:sleep(500),exit(Client,kill) end),
+ spawn(fun() -> ct:sleep(500),exit(Client,kill) end),
?NS:expect(get),
{error,{closed,killed}}=ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}),
ok.
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
index f7c7b891bb..e4bc396536 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
@@ -351,7 +351,7 @@ check_expected(SessionId,ConnRef,Msg) ->
do(ConnRef, Do),
reply(ConnRef,Reply);
error ->
- timer:sleep(1000),
+ ct:sleep(1000),
exit({error,{got_unexpected,SessionId,Msg,ets:tab2list(ns_tab)}})
end.
@@ -548,8 +548,13 @@ make_msg({hello,SessionId,Stuff}) ->
SessionIdXml/binary,"</hello>">>);
make_msg(ok) ->
xml(rpc_reply("<ok/>"));
+
+make_msg({ok,Data}) ->
+ xml(rpc_reply(from_simple({ok,Data})));
+
make_msg({data,Data}) ->
xml(rpc_reply(from_simple({data,Data})));
+
make_msg(event) ->
xml(<<"<notification xmlns=\"",?NETCONF_NOTIF_NAMESPACE,"\">"
"<eventTime>2012-06-14T14:50:54+02:00</eventTime>"
diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
index 5de1ecc2bd..1e6018f442 100644
--- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
@@ -91,27 +91,27 @@ pre_post_io(Config) ->
spawn(fun() ->
ct:pal("CONTROLLER: Started!", []),
%% --- test run 1 ---
- timer:sleep(3000),
+ ct:sleep(3000),
ct:pal("CONTROLLER: Handle remote events = true", []),
ok = ct_test_support:ct_rpc({cth_log_redirect,
handle_remote_events,
[true]}, Config),
- timer:sleep(2000),
+ ct:sleep(2000),
ct:pal("CONTROLLER: Proceeding with test run #1!", []),
ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
- timer:sleep(6000),
+ ct:sleep(6000),
ct:pal("CONTROLLER: Proceeding with shutdown #1!", []),
ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
%% --- test run 2 ---
- timer:sleep(3000),
+ ct:sleep(3000),
ct:pal("CONTROLLER: Handle remote events = true", []),
ok = ct_test_support:ct_rpc({cth_log_redirect,
handle_remote_events,
[true]}, Config),
- timer:sleep(2000),
+ ct:sleep(2000),
ct:pal("CONTROLLER: Proceeding with test run #2!", []),
ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
- timer:sleep(6000),
+ ct:sleep(6000),
ct:pal("CONTROLLER: Proceeding with shutdown #2!", []),
ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config)
end),
diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl
index e37aeb196c..50e07608f6 100644
--- a/lib/common_test/test/ct_repeat_1_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_1_SUITE.erl
@@ -220,8 +220,7 @@ test_events(repeat_cs_and_grs) ->
{?eh,test_stats,{1,1,{0,0}}},
[{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}},
{?eh,test_stats,{2,1,{0,0}}},
- {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}],
{?eh,test_stats,{3,1,{0,0}}},
[{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]},
{failed,{error,fails_on_purpose}}}},
@@ -242,8 +241,7 @@ test_events(repeat_cs_and_grs) ->
{?eh,test_stats,{5,2,{0,1}}},
[{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}},
{?eh,test_stats,{6,2,{0,1}}},
- {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}],
{?eh,test_stats,{7,2,{0,1}}},
[{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]},
{failed,{error,fails_on_purpose}}}},
@@ -289,8 +287,7 @@ test_events(repeat_seq) ->
{init_per_group,gr_fail_result,[]},ok}},
{?eh,test_stats,{4,2,{0,2}}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result,[]},ok}}],
{?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_2},
{group_result,gr_fail_result,failed}}},
{?eh,test_stats,{4,2,{0,3}}},
@@ -402,8 +399,7 @@ test_events(repeat_gr_until_any_ok) ->
[{?eh,tc_done,{repeat_1_SUITE,
{init_per_group,gr_fail_result,[]},ok}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,tc_fail_1,
{failed,{error,{{badmatch,2},'_'}}}}},
{?eh,test_stats,{1,1,{0,0}}},
@@ -418,8 +414,7 @@ test_events(repeat_gr_until_any_ok) ->
[{?eh,tc_done,{repeat_1_SUITE,
{init_per_group,gr_fail_result_then_ok,[]},ok}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result_then_ok,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result_then_ok,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,
{end_per_group,repeat_gr_until_any_ok_1,
[{repeat_until_any_ok,3}]},ok}}],
@@ -441,8 +436,7 @@ test_events(repeat_gr_until_any_ok) ->
{init_per_group,repeat_gr_until_any_ok_2,
[{repeat_until_any_ok,3}]},ok}},
[{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,tc_fail_1,
{failed,{error,{{badmatch,2},'_'}}}}},
{?eh,test_stats,{5,5,{0,2}}},
@@ -675,8 +669,7 @@ test_events(repeat_gr_until_any_fail) ->
{repeat_1_SUITE,{end_per_group,gr_ok_then_fail_result,[]}}},
{?eh,tc_done,
{repeat_1_SUITE,
- {end_per_group,gr_ok_then_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_ok_then_fail_result,[]},ok}}],
{?eh,tc_start,{repeat_1_SUITE,tc_ok_2}},
{?eh,tc_done,{repeat_1_SUITE,tc_ok_2,ok}},
{?eh,test_stats,{8,0,{0,0}}},
@@ -938,8 +931,7 @@ test_events(repeat_gr_until_all_ok) ->
{?eh,tc_done,{repeat_1_SUITE,tc_ok_1,ok}},
{?eh,test_stats,{3,1,{0,0}}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result_then_ok,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result_then_ok,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,
{end_per_group,repeat_gr_until_all_ok_1,
[{repeat_until_all_ok,3}]},ok}}],
@@ -1113,8 +1105,7 @@ test_events(repeat_gr_until_all_fail) ->
gr_ok_then_fail_result,[]},ok}},
{?eh,test_stats,{3,3,{0,2}}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_ok_then_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_ok_then_fail_result,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,
{end_per_group,repeat_gr_until_all_fail_1,
[{repeat_until_all_fail,2}]},ok}}],
@@ -1148,8 +1139,7 @@ test_events(repeat_gr_until_all_fail) ->
{init_per_group,repeat_gr_until_all_fail_3,
[{repeat_until_all_fail,3}]},ok}},
[{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1,ok}},
{?eh,test_stats,{6,5,{0,3}}},
{?eh,tc_done,{repeat_1_SUITE,
@@ -1159,8 +1149,7 @@ test_events(repeat_gr_until_all_fail) ->
{init_per_group,repeat_gr_until_all_fail_3,
[{repeat_until_all_fail,2}]},ok}},
[{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_fail_result,[]},ok}}],
{?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1,
{failed,{error,failing_this_time}}}},
{?eh,test_stats,{7,6,{0,3}}},
@@ -1263,8 +1252,7 @@ test_events(repeat_seq_until_any_fail) ->
{init_per_group,repeat_seq_until_any_fail_4,
[{repeat_until_any_fail,2},sequence]},ok}},
[{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_ok_then_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_ok_then_fail_result,[]},ok}}],
{?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1},
{group_result,gr_ok_then_fail_result,failed}}},
{?eh,test_stats,{19,1,{0,3}}},
@@ -1473,8 +1461,7 @@ test_events(repeat_shuffled_seq_until_any_fail) ->
[{?eh,tc_start,{repeat_1_SUITE,
{end_per_group,gr_ok_then_fail_result,[]}}},
{?eh,tc_done,{repeat_1_SUITE,
- {end_per_group,gr_ok_then_fail_result,[]},
- {return_group_result,failed}}}],
+ {end_per_group,gr_ok_then_fail_result,[]},ok}}],
{?eh,tc_start,{repeat_1_SUITE,
{end_per_group,repeat_shuffled_seq_until_any_fail_4,
[{shuffle,repeated},{repeat_until_any_fail,2},sequence]}}},
diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl
index 3fd5943691..3d7049a9c4 100644
--- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl
@@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) ->
%%%-----------------------------------------------------------------
%%% Test cases
tc1(_Config) ->
- timer:sleep(10000),
+ ct:sleep(10000),
ok.
tc2(_Config) ->
diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl
index dc9abc2863..e4f6e7dcc1 100644
--- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl
@@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) ->
%%%-----------------------------------------------------------------
%%% Test cases
tc1(_Config) ->
- %% timer:sleep(3000),
+ %% ct:sleep(3000),
ok.
tc2(_Config) ->
diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl
index 5a775a1117..4055cd789e 100644
--- a/lib/common_test/test/ct_sequence_1_SUITE.erl
+++ b/lib/common_test/test/ct_sequence_1_SUITE.erl
@@ -182,8 +182,7 @@ test_events(subgroup_return_fail) ->
{?eh,test_stats,{0,1,{0,0}}},
{?eh,tc_start,
{subgroups_1_SUITE,{end_per_group,return_fail,[]}}},
- {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},
- {return_group_result,failed}}}],
+ {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}],
{?eh,tc_auto_skip,
{subgroups_1_SUITE,{ok_tc,ok_group},
{group_result,return_fail,failed}}},
@@ -191,8 +190,7 @@ test_events(subgroup_return_fail) ->
{?eh,tc_start,
{subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}}},
{?eh,tc_done,
- {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]},
- {return_group_result,failed}}}],
+ {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]},ok}}],
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -221,8 +219,7 @@ test_events(subgroup_init_fail) ->
{?eh,test_stats,{0,0,{0,2}}},
{?eh,tc_start,{subgroups_1_SUITE,{end_per_group,subgroup_init_fail,[sequence]}}},
{?eh,tc_done,{subgroups_1_SUITE,
- {end_per_group,subgroup_init_fail,[sequence]},
- {return_group_result,failed}}}],
+ {end_per_group,subgroup_init_fail,[sequence]},ok}}],
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -245,8 +242,7 @@ test_events(subgroup_after_failed_case) ->
{?eh,tc_start,{subgroups_1_SUITE,
{end_per_group,subgroup_after_failed_case,[sequence]}}},
{?eh,tc_done,{subgroups_1_SUITE,
- {end_per_group,subgroup_after_failed_case,[sequence]},
- {return_group_result,failed}}}],
+ {end_per_group,subgroup_after_failed_case,[sequence]},ok}}],
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -266,16 +262,14 @@ test_events(case_after_subgroup_return_fail) ->
{?eh,tc_done,{subgroups_1_SUITE,failing_tc,{failed,{error,{{badmatch,3},'_'}}}}},
{?eh,test_stats,{0,1,{0,0}}},
{?eh,tc_start,{subgroups_1_SUITE,{end_per_group,return_fail,[]}}},
- {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},
- {return_group_result,failed}}}],
+ {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}],
{?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,case_after_subgroup_return_fail},
{group_result,return_fail,failed}}},
{?eh,test_stats,{0,1,{0,1}}},
{?eh,tc_start,{subgroups_1_SUITE,
{end_per_group,case_after_subgroup_return_fail,[sequence]}}},
{?eh,tc_done,{subgroups_1_SUITE,
- {end_per_group,case_after_subgroup_return_fail,[sequence]},
- {return_group_result,failed}}}],
+ {end_per_group,case_after_subgroup_return_fail,[sequence]},ok}}],
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -310,8 +304,7 @@ test_events(case_after_subgroup_fail_init) ->
{?eh,tc_start,{subgroups_1_SUITE,
{end_per_group,case_after_subgroup_fail_init,[sequence]}}},
{?eh,tc_done,{subgroups_1_SUITE,
- {end_per_group,case_after_subgroup_fail_init,[sequence]},
- {return_group_result,failed}}}],
+ {end_per_group,case_after_subgroup_fail_init,[sequence]},ok}}],
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
].
diff --git a/lib/common_test/test/ct_shell_SUITE.erl b/lib/common_test/test/ct_shell_SUITE.erl
index 4b8c43d800..70c0ab8127 100644
--- a/lib/common_test/test/ct_shell_SUITE.erl
+++ b/lib/common_test/test/ct_shell_SUITE.erl
@@ -93,7 +93,7 @@ start_interactive(Config) ->
test_server:format(Level,
"ct_util_server not stopped on ~p yet, waiting 5 s...~n",
[CTNode]),
- timer:sleep(5000),
+ ct:sleep(5000),
undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server])
end,
Events = ct_test_support:get_events(ERPid, Config),
diff --git a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl
index 825846cd55..89e202a404 100644
--- a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl
+++ b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl
@@ -72,7 +72,7 @@ end_per_group(_GroupName, _Config) ->
%% Reason = term()
%%--------------------------------------------------------------------
init_per_testcase(tc1, Config) ->
- timer:sleep(5000),
+ ct:sleep(5000),
Config;
init_per_testcase(_TestCase, Config) ->
Config.
diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl
index 49b38361e2..6077946c33 100644
--- a/lib/common_test/test/ct_smoke_test_SUITE.erl
+++ b/lib/common_test/test/ct_smoke_test_SUITE.erl
@@ -480,7 +480,7 @@ events(Test) when Test == dir1 ; Test == dir2 ;
{Suite,tc4,{skipped,"Skipping this one"}}},
{?eh,test_stats,{7,0,{1,0}}},
{?eh,tc_start,{Suite,end_per_suite}},
- {?eh,tc_done,{Suite,end_per_suite,ips_data}},
+ {?eh,tc_done,{Suite,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -517,7 +517,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 ->
{happy_11_SUITE,tc4,{skipped,"Skipping this one"}}},
{?eh,test_stats,{7,0,{1,0}}},
{?eh,tc_start,{happy_11_SUITE,end_per_suite}},
- {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}},
+ {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}},
{?eh,tc_start,{happy_21_SUITE,init_per_suite}},
{?eh,tc_done,{happy_21_SUITE,init_per_suite,ok}},
{?eh,tc_start,{happy_21_SUITE,tc1}},
@@ -546,7 +546,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 ->
{happy_21_SUITE,tc4,{skipped,"Skipping this one"}}},
{?eh,test_stats,{14,0,{2,0}}},
{?eh,tc_start,{happy_21_SUITE,end_per_suite}},
- {?eh,tc_done,{happy_21_SUITE,end_per_suite,ips_data}},
+ {?eh,tc_done,{happy_21_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -563,7 +563,7 @@ events(Test) when Test == tc111 ; Test == tc211 ->
{?eh,tc_done,{Suite,tc1,ok}},
{?eh,test_stats,{1,0,{0,0}}},
{?eh,tc_start,{Suite,end_per_suite}},
- {?eh,tc_done,{Suite,end_per_suite,ips_data}},
+ {?eh,tc_done,{Suite,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -582,7 +582,7 @@ events(tc111_112) ->
{?eh,tc_done,{happy_11_SUITE,tc2,ok}},
{?eh,test_stats,{2,0,{0,0}}},
{?eh,tc_start,{happy_11_SUITE,end_per_suite}},
- {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}},
+ {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
].
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl
index e20832e1e7..07f7bf02e4 100644
--- a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl
@@ -117,12 +117,12 @@ break(_Config) ->
start_stop(Config) ->
ok = ct_snmp:start(Config,snmp1,snmp_app1),
- timer:sleep(1000),
+ ct:sleep(1000),
{snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()),
[_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
ok = ct_snmp:stop(Config),
- timer:sleep(1000),
+ ct:sleep(1000),
false = lists:keyfind(snmp,1,application:which_applications()),
[] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
ok.
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
index bd5d76266a..1d3f5918d2 100644
--- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
@@ -283,14 +283,14 @@ large_string(_) ->
%% yield the same result as the single request case.
ok = ct_telnet:send(Handle, "echo_sep "++BigString),
- timer:sleep(1000),
+ ct:sleep(1000),
{ok,Data1} = ct_telnet:get_data(Handle),
ct:log("[GET DATA #1] Received ~w chars: ~s",
[length(lists:flatten(Data1)),Data1]),
VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>],
ok = ct_telnet:send(Handle, "echo_sep "++BigString),
- timer:sleep(50),
+ ct:sleep(50),
{ok,Data2} = ct_telnet:get_data(Handle),
ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]),
VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>],
@@ -316,7 +316,7 @@ server_speaks(_) ->
"echo_no_prompt This is the second message"),
%% Let ct_telnet_client get an idle timeout. This should print the
%% two messages to the log. Note that the buffers are not flushed here!
- timer:sleep(15000),
+ ct:sleep(15000),
ok = ct_telnet_client:send_data(Backdoor,
"echo_no_prompt This is the third message"),
{ok,_} = ct_telnet:expect(Handle, ["first.*second.*third"],
@@ -326,7 +326,7 @@ server_speaks(_) ->
ok = ct_telnet_client:send_data(Backdoor,
"echo_no_prompt This is the fourth message"),
%% give the server time to respond
- timer:sleep(2000),
+ ct:sleep(2000),
%% closing the connection should print last message in log
ok = ct_telnet:close(Handle),
ok.
@@ -338,11 +338,11 @@ server_disconnects(_) ->
ok = ct_telnet:send(Handle, "disconnect_after 1500"),
%% wait until the get_data operation (triggered by send/2) times out
%% before sending the msg
- timer:sleep(500),
+ ct:sleep(500),
ok = ct_telnet:send(Handle, "echo_no_prompt This is the message"),
%% when the server closes the connection, the last message should be
%% printed in the log
- timer:sleep(3000),
+ ct:sleep(3000),
_ = ct_telnet:close(Handle),
ok.
diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl
index 06fa6ac638..d30feb0bd2 100644
--- a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl
+++ b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl
@@ -76,7 +76,7 @@ end_per_group(_GroupName, _Config) ->
%% Reason = term()
%%--------------------------------------------------------------------
init_per_testcase(tc1, Config) ->
- timer:sleep(5000),
+ ct:sleep(5000),
Config;
init_per_testcase(tc8, _Config) ->
{skip,"tc8 skipped"};
@@ -92,7 +92,7 @@ init_per_testcase(_TestCase, Config) ->
%% Config0 = Config1 = [tuple()]
%%--------------------------------------------------------------------
end_per_testcase(tc2, Config) ->
- timer:sleep(5000);
+ ct:sleep(5000);
end_per_testcase(tc12, Config) ->
ct:comment("end_per_testcase(tc12) called!"),
ct:pal("end_per_testcase(tc12) called!", []),
@@ -146,7 +146,7 @@ tc2(_) ->
timeout_in_end_per_testcase.
tc3(_) ->
- timer:sleep(5000).
+ ct:sleep(5000).
tc4(_) ->
exit(failed_on_purpose).
@@ -186,7 +186,7 @@ gtc2(_) ->
tc12(_) ->
F = fun() -> ct:abort_current_testcase('stopping tc12') end,
spawn(F),
- timer:sleep(1000),
+ ct:sleep(1000),
exit(should_have_been_aborted).
tc13(_) ->
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index 2c1f98d63b..ca736fe400 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -51,12 +51,12 @@ init_per_suite(Config) ->
init_per_suite(Config, 50).
init_per_suite(Config, Level) ->
+ ScaleFactor = test_server:timetrap_scale_factor(),
case os:type() of
{win32, _} ->
%% Extend timeout to 1 hour for windows as starting node
%% can take a long time there
- test_server:timetrap( 60*60*1000 *
- test_server:timetrap_scale_factor());
+ test_server:timetrap( 60*60*1000 * ScaleFactor );
_ ->
ok
end,
@@ -67,6 +67,16 @@ init_per_suite(Config, Level) ->
_ ->
ok
end,
+
+ {Mult,Scale} = test_server_ctrl:get_timetrap_parameters(),
+ test_server:format(Level, "Timetrap multiplier: ~w~n", [Mult]),
+ if Scale == true ->
+ test_server:format(Level, "Timetrap scale factor: ~w~n",
+ [ScaleFactor]);
+ true ->
+ ok
+ end,
+
start_slave(Config, Level).
start_slave(Config, Level) ->
diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl
index c2670316b6..bc19283a47 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE.erl
@@ -795,7 +795,7 @@ test_events(skip_all_groups) ->
{?eh,test_stats,{0,0,{12,0}}},
{?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_4},"SKIPPED!"}},
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
@@ -840,7 +840,7 @@ test_events(skip_group) ->
{?eh,test_stats,{2,0,{6,0}}},
{?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_2},
"SKIPPED!"}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
@@ -876,7 +876,7 @@ test_events(skip_group_all_testcases) ->
{?eh,test_stats,{0,0,{4,0}}},
{?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b},
"SKIPPED!"}},
- {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}},
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
@@ -1065,7 +1065,7 @@ test_events(skip_subgroup) ->
{?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}],
{?eh,tc_start,{groups_12_SUITE,end_per_suite}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}},
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl
index 69c06f9b83..e5de5df1a8 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl
@@ -285,7 +285,7 @@ testcase_5a(Config) ->
%% increase chance the done event will come
%% during execution of subgroup (could be
%% tricky to handle)
- timer:sleep(3),
+ ct:sleep(3),
ok.
testcase_5b() ->
[].
diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl
index cd517876df..dcd361d658 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl
@@ -278,7 +278,7 @@ testcase_5a(Config) ->
%% increase chance the done event will come
%% during execution of subgroup (could be
%% tricky to handle)
- timer:sleep(3),
+ ct:sleep(3),
ok.
testcase_5b() ->
[].
diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl
index d25ee62d38..11959c3e12 100644
--- a/lib/common_test/test/telnet_server.erl
+++ b/lib/common_test/test/telnet_server.erl
@@ -59,7 +59,7 @@ init(Opts) ->
accept(State),
ok = gen_tcp:close(LSock),
dbg("telnet_server closed the listen socket ~p\n", [LSock]),
- timer:sleep(1000),
+ ct:sleep(1000),
ok.
listen(0, _Port, _Opts) ->
@@ -68,7 +68,7 @@ listen(Retries, Port, Opts) ->
case gen_tcp:listen(Port, Opts) of
{error,eaddrinuse} ->
dbg("Listen port not released, trying again..."),
- timer:sleep(5000),
+ ct:sleep(5000),
listen(Retries-1, Port, Opts);
Ok = {ok,_LSock} ->
Ok;
@@ -220,7 +220,7 @@ do_handle_data("echo_sep " ++ Data,State) ->
Msgs = string:tokens(Data," "),
lists:foreach(fun(Msg) ->
send(Msg,State),
- timer:sleep(10)
+ ct:sleep(10)
end, Msgs),
send("\r\n> ",State),
{ok,State};
@@ -292,7 +292,7 @@ send_loop(T0,T,Data,State) ->
ok;
true ->
send(Data,State),
- timer:sleep(500),
+ ct:sleep(500),
send_loop(T0,T,Data,State)
end.
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 2032392821..7c4cebdc28 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -159,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl
$(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl
$(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $<
+# Inlining core_parse is slow and has no benefit.
+$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl
+ $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $<
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 92f09e400c..5216f39296 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -252,13 +252,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
%% opt([Instruction]) -> [Instruction]
%% Optimize the instruction stream inside a basic block.
-opt([{set,[Dst],As,{bif,Bif,Fail}}=I1,
- {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) ->
- %% Get rid of the 'not' if the operation can be inverted.
- case inverse_comp_op(Bif) of
- none -> [I1,I2|opt(Is)];
- RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)]
- end;
opt([{set,[X],[X],move}|Is]) -> opt(Is);
opt([{set,_,_,{line,_}}=Line1,
{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
@@ -428,18 +421,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
-%% inverse_comp_op(Op) -> none|RevOp
-
-inverse_comp_op('=:=') -> '=/=';
-inverse_comp_op('=/=') -> '=:=';
-inverse_comp_op('==') -> '/=';
-inverse_comp_op('/=') -> '==';
-inverse_comp_op('>') -> '=<';
-inverse_comp_op('<') -> '>=';
-inverse_comp_op('>=') -> '<';
-inverse_comp_op('=<') -> '>';
-inverse_comp_op(_) -> none.
-
%%%
%%% Evaluation of constant bit fields.
%%%
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index a452d30b61..5ed9c16d61 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) ->
initialized_regs(Is) ->
initialized_regs(Is, ordsets:new()).
+initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) ->
+ Regs = add_init_regs(free_vars_regs(Live), Regs0),
+ add_init_regs(Dst, Regs);
initialized_regs([{set,Dst,Src,_}|Is], Regs) ->
initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs)));
initialized_regs([{test,_,_,Src}|Is], Regs) ->
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 7cd07dc3be..f4515ba2a7 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc).
forward(Is, Lc) ->
forward(Is, gb_trees:empty(), Lc, []).
+forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) ->
+ %% move/2 followed by jump/1 is optimized by backward/3.
+ forward([Move,{jump,{f,L}}|Is], D, Lc, Acc);
+forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) ->
+ %% bif/4 followed by jump/1 is optimized by backward/3.
+ forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc);
forward([{block,[]}|Is], D, Lc, Acc) ->
%% Empty blocks can prevent optimizations.
forward(Is, D, Lc, Acc);
@@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) ->
_ -> Is0 %Keep move instruction.
end,
forward(Is, D, Lc, [LblI|Acc]);
+forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) ->
+ forward(Is, D, Lc, Acc);
forward([{test,is_eq_exact,_,[Dst,Src]}=I,
{block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) ->
forward([I,{block,Bl}|Is], D, Lc, Acc);
@@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) ->
Fail = shortcut_bs_test(Fail1, Is, D),
Sel = {select,select_val,Reg,{f,Fail},List},
backward(Is, D, [Sel|Acc]);
-backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) ->
- To1 = shortcut_select_label(To0, Reg, Src0, D),
- {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D),
- Move = {move,Src,Reg},
+backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
+ To = shortcut_select_label(To0, Reg, Src, D),
Jump = {jump,{f,To}},
case beam_utils:is_killed_at(Reg, To, D) of
false -> backward([Move|Is], D, [Jump|Acc]);
@@ -330,16 +336,6 @@ shortcut_label(To0, D) ->
shortcut_select_label(To, Reg, Lit, D) ->
shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D).
-shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) ->
- case beam_utils:code_at(To0, D) of
- [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] ->
- Bool = {atom,not Bool0},
- {shortcut_select_label(To, Reg, Bool, D),Bool};
- _ ->
- {To0,Lit}
- end;
-shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}.
-
%% Replace a comparison operator with a test instruction and a jump.
%% For example, if we have this code:
%%
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index 97a8c7ba70..5abacc8d5d 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
%% has succeeded.
peep(Is, gb_sets:empty(), [I|Acc]);
true ->
- Test = {Op,Ops},
- case gb_sets:is_element(Test, SeenTests0) of
+ case is_test_redundant(Op, Ops, SeenTests0) of
true ->
- %% This test has already succeeded and
+ %% This test or a similar test has already succeeded and
%% is therefore redundant.
peep(Is, SeenTests0, Acc);
false ->
%% Remember that we have seen this test.
+ Test = {Op,Ops},
SeenTests = gb_sets:insert(Test, SeenTests0),
peep(Is, SeenTests, [I|Acc])
end
@@ -136,6 +136,15 @@ peep([I|Is], _, Acc) ->
peep(Is, gb_sets:empty(), [I|Acc]);
peep([], _, Acc) -> reverse(Acc).
+is_test_redundant(Op, Ops, Seen) ->
+ gb_sets:is_element({Op,Ops}, Seen) orelse
+ is_test_redundant_1(Op, Ops, Seen).
+
+is_test_redundant_1(is_boolean, [R], Seen) ->
+ gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse
+ gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen);
+is_test_redundant_1(_, _, _) -> false.
+
kill_seen(Dst, Seen0) ->
gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 3d4b9ee0c6..8367a1e19e 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -138,7 +138,8 @@
]).
-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0,
- c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0,
+ c_let/0, c_literal/0, c_map/0, c_map_pair/0,
+ c_module/0, c_tuple/0,
c_values/0, c_var/0, cerl/0, var_name/0]).
-include("core_parse.hrl").
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ea1959d0f8..0d020578f5 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -96,7 +96,7 @@
t=[], %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool'.
+-type type_info() :: cerl:cerl() | 'bool' | 'integer'.
-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
-type sub() :: #sub{}.
@@ -297,7 +297,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false -> Seq0#c_seq{arg=Arg,body=B1}
end
end;
-expr(#c_let{}=Let, Ctxt, Sub) ->
+expr(#c_let{}=Let0, Ctxt, Sub) ->
+ Let = opt_case_in_let(Let0),
case simplify_let(Let, Sub) of
impossible ->
%% The argument for the let is "simple", i.e. has no
@@ -829,16 +830,16 @@ eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) ->
maybe -> Call;
no -> #c_literal{val=false}
end;
-eval_rel_op(Call, '==', Ops, _Sub) ->
- case is_exact_eq_ok(Ops) of
+eval_rel_op(Call, '==', Ops, Sub) ->
+ case is_exact_eq_ok(Ops, Sub) of
true ->
Name = #c_literal{anno=cerl:get_ann(Call),val='=:='},
Call#c_call{name=Name};
false ->
Call
end;
-eval_rel_op(Call, '/=', Ops, _Sub) ->
- case is_exact_eq_ok(Ops) of
+eval_rel_op(Call, '/=', Ops, Sub) ->
+ case is_exact_eq_ok(Ops, Sub) of
true ->
Name = #c_literal{anno=cerl:get_ann(Call),val='=/='},
Call#c_call{name=Name};
@@ -847,11 +848,17 @@ eval_rel_op(Call, '/=', Ops, _Sub) ->
end;
eval_rel_op(Call, _, _, _) -> Call.
-is_exact_eq_ok([#c_literal{val=Lit}|_]) ->
+is_exact_eq_ok([A,B]=L, Sub) ->
+ case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of
+ true -> true;
+ false -> is_exact_eq_ok_1(L)
+ end.
+
+is_exact_eq_ok_1([#c_literal{val=Lit}|_]) ->
is_non_numeric(Lit);
-is_exact_eq_ok([_|T]) ->
- is_exact_eq_ok(T);
-is_exact_eq_ok([]) -> false.
+is_exact_eq_ok_1([_|T]) ->
+ is_exact_eq_ok_1(T);
+is_exact_eq_ok_1([]) -> false.
is_non_numeric([H|T]) ->
is_non_numeric(H) andalso is_non_numeric(T);
@@ -963,7 +970,7 @@ eval_element(Call, #c_literal{val=Pos}, Tuple, Types)
1 =< Pos, Pos =< length(Es) ->
El = lists:nth(Pos, Es),
try
- pat_to_expr(El)
+ cerl:set_ann(pat_to_expr(El), [compiler_generated])
catch
throw:impossible ->
Call
@@ -1008,28 +1015,32 @@ eval_is_record(Call, _, _, _, _) -> Call.
%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
%% Evaluates setelement/3 if position Pos is an integer
-%% the shape of the tuple Tuple is known.
+%% and the shape of the tuple Tuple is known.
%%
-eval_setelement(Call, Pos, Tuple, NewVal) ->
- try
- eval_setelement_1(Pos, Tuple, NewVal)
- catch
- error:_ ->
- Call
- end.
-
-eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal)
- when is_integer(Pos) ->
- ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal));
-eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal)
+eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal)
when is_integer(Pos) ->
- Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)],
- ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)).
+ case cerl:is_data(Tuple) of
+ false ->
+ Call;
+ true ->
+ Es0 = case cerl:is_c_tuple(Tuple) of
+ false -> [];
+ true -> cerl:tuple_es(Tuple)
+ end,
+ if
+ 1 =< Pos, Pos =< length(Es0) ->
+ Es = eval_setelement_1(Pos, Es0, NewVal),
+ cerl:update_c_tuple(Tuple, Es);
+ true ->
+ eval_failure(Call, badarg)
+ end
+ end;
+eval_setelement(Call, _, _, _) -> Call.
-eval_setelement_2(1, [_|T], NewVal) ->
+eval_setelement_1(1, [_|T], NewVal) ->
[NewVal|T];
-eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 ->
- [H|eval_setelement_2(Pos-1, T, NewVal)].
+eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 ->
+ [H|eval_setelement_1(Pos-1, T, NewVal)].
%% eval_failure(Call, Reason) -> Core.
%% Warn for a call that will fail and replace the call with
@@ -1955,46 +1966,125 @@ letify(Bs, Body) ->
cerl:ann_c_let(Ann, [V], Val, B)
end, Body, Bs).
-%% opt_case_in_let(LetExpr) -> LetExpr'
+%% opt_not_in_let(Let) -> Cerl
+%% Try to optimize away a 'not' operator in a 'let'.
-opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
- opt_case_in_let_0(Vs, Arg, B, Let, Sub).
+-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl().
-opt_case_in_let_0([#c_var{name=V}], Arg,
- #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) ->
- case opt_case_in_let_1(V, Arg, Cs) of
- impossible ->
- case is_simple_case_arg(Arg) andalso
- not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
- true ->
- expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub));
- false ->
- Let
+opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
+ case opt_not_in_let(Vs0, Arg0, Body0) of
+ {[],#c_values{es=[]},Body} ->
+ Body;
+ {Vs,Arg,Body} ->
+ Let#c_let{vars=Vs,arg=Arg,body=Body}
+ end;
+opt_not_in_let(Let) -> Let.
+
+%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'}
+%% Try to optimize away a 'not' operator in a 'let'.
+
+-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) ->
+ {[cerl:c_var()],cerl:cerl(),cerl:cerl()}.
+
+opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
+ case cerl:type(Body0) of
+ call ->
+ %% let <V> = Expr in not V ==>
+ %% let <> = <> in notExpr
+ case opt_not_in_let_1(V, Body0, Arg0) of
+ no ->
+ {Vs0,Arg0,Body0};
+ {yes,Body} ->
+ {[],#c_values{es=[]},Body}
end;
- Expr -> Expr
+ 'let' ->
+ %% let <V> = Expr in let <Var> = not V in Body ==>
+ %% let <Var> = notExpr in Body
+ %% V must not be used in Body.
+ LetArg = cerl:let_arg(Body0),
+ case opt_not_in_let_1(V, LetArg, Arg0) of
+ no ->
+ {Vs0,Arg0,Body0};
+ {yes,Arg} ->
+ LetBody = cerl:let_body(Body0),
+ case core_lib:is_var_used(V, LetBody) of
+ true ->
+ {Vs0,Arg0,Body0};
+ false ->
+ LetVars = cerl:let_vars(Body0),
+ {LetVars,Arg,LetBody}
+ end
+ end;
+ _ ->
+ {Vs0,Arg0,Body0}
end;
-opt_case_in_let_0(_, _, _, Let, _) -> Let.
-
-opt_case_in_let_1(V, Arg, Cs) ->
- try
- opt_case_in_let_2(V, Arg, Cs)
- catch
- _:_ -> impossible
+opt_not_in_let(Vs, Arg, Body) ->
+ {Vs,Arg,Body}.
+
+opt_not_in_let_1(V, Call, Body) ->
+ case Call of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val='not'},
+ args=[#c_var{name=V}]} ->
+ opt_not_in_let_2(Body);
+ _ ->
+ no
end.
-opt_case_in_let_2(V, Arg0,
- [#c_clause{pats=[#c_tuple{es=Es}],
- guard=#c_literal{val=true},body=B}|_]) ->
+opt_not_in_let_2(#c_case{clauses=Cs0}=Case) ->
+ Vars = make_vars([], 1),
+ Body = #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val='not'},
+ args=Vars},
+ Cs = [begin
+ Let = #c_let{vars=Vars,arg=B,body=Body},
+ C#c_clause{body=opt_not_in_let(Let)}
+ end || #c_clause{body=B}=C <- Cs0],
+ {yes,Case#c_case{clauses=Cs}};
+opt_not_in_let_2(#c_call{}=Call0) ->
+ invert_call(Call0);
+opt_not_in_let_2(_) -> no.
+
+invert_call(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=Name0},
+ args=[_,_]}=Call) ->
+ case inverse_rel_op(Name0) of
+ no -> no;
+ Name -> {yes,Call#c_call{name=#c_literal{val=Name}}}
+ end;
+invert_call(#c_call{}) -> no.
+
+%% inverse_rel_op(Op) -> no | RevOp
+
+inverse_rel_op('=:=') -> '=/=';
+inverse_rel_op('=/=') -> '=:=';
+inverse_rel_op('==') -> '/=';
+inverse_rel_op('/=') -> '==';
+inverse_rel_op('>') -> '=<';
+inverse_rel_op('<') -> '>=';
+inverse_rel_op('>=') -> '<';
+inverse_rel_op('=<') -> '>';
+inverse_rel_op(_) -> no.
- %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end.
- %% avoid building tuples, by converting tuples to multiple values.
- %% (The optimisation is not done if the built tuple is used or returned.)
- true = all(fun (#c_var{}) -> true;
- (_) -> false end, Es), %Only variables in tuple
- false = core_lib:is_var_used(V, B), %Built tuple must not be used.
- Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail.
- #c_let{vars=Es,arg=Arg1,body=B}.
+%% opt_bool_case_in_let(LetExpr, Sub) -> Core
+
+opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
+ opt_case_in_let_1(Vs, Arg, B, Let, Sub).
+
+opt_case_in_let_1([#c_var{name=V}], Arg,
+ #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) ->
+ case is_simple_case_arg(Arg) of
+ true ->
+ Case = opt_bool_case(Case0#c_case{arg=Arg}),
+ case core_lib:is_var_used(V, Case) of
+ false -> expr(Case, sub_new(Sub));
+ true -> Let
+ end;
+ false ->
+ Let
+ end;
+opt_case_in_let_1(_, _, _, Let, _) -> Let.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2036,7 +2126,7 @@ is_bool_expr(#c_clause{body=B}, Sub) ->
is_bool_expr(B, Sub);
is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) ->
Sub = case is_bool_expr(Arg, Sub0) of
- true -> update_types(V, [#c_literal{val=true}], Sub0);
+ true -> update_types(V, [bool], Sub0);
false -> Sub0
end,
is_bool_expr(B, Sub);
@@ -2122,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) ->
end;
is_safe_bool_expr_list([], _, _) -> true.
-%% tuple_to_values(Expr, TupleArity) -> Expr'
-%% Convert tuples in return position of arity TupleArity to values.
-%% Throws an exception for constructs that are not handled.
-
-tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity ->
- core_lib:make_values(Es);
-tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity ->
- Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)],
- core_lib:make_values(Es);
-tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) ->
- Cs1 = [tuple_to_values(E, Arity) || E <- Cs0],
- Case#c_case{clauses=Cs1};
-tuple_to_values(#c_seq{body=B0}=Seq, Arity) ->
- Seq#c_seq{body=tuple_to_values(B0, Arity)};
-tuple_to_values(#c_let{body=B0}=Let, Arity) ->
- Let#c_let{body=tuple_to_values(B0, Arity)};
-tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) ->
- Cs = [tuple_to_values(E, Arity) || E <- Cs0],
- A = case Timeout of
- #c_literal{val=infinity} -> A0;
- _ -> tuple_to_values(A0, Arity)
- end,
- Rec#c_receive{clauses=Cs,action=A};
-tuple_to_values(#c_clause{body=B0}=Clause, Arity) ->
- B = tuple_to_values(B0, Arity),
- Clause#c_clause{body=B};
-tuple_to_values(Expr, _) ->
- case will_fail(Expr) of
- true -> Expr;
- false -> erlang:error({not_handled,Expr})
- end.
-
%% simplify_let(Let, Sub) -> Expr | impossible
%% If the argument part of an let contains a complex expression, such
%% as a let or a sequence, move the original let body into the complex
@@ -2180,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
Arg = body(Arg0, Sub0),
ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
{OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0),
-
+
OuterBody = body(OuterBody0, ScopeSub),
{InnerVs,Sub} = pattern_list(InnerVs0, Sub0),
@@ -2258,50 +2316,179 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
+%% opt_case_in_let(Let) -> Let'
+%% Try to avoid building tuples that are immediately matched.
+%% A common pattern is:
+%%
+%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end
+%%
+%% In Core Erlang the pattern would look like this:
+%%
+%% let <V> = case E of
+%% ... -> ... {Val1,Val2}
+%% ...
+%% end,
+%% in case V of
+%% {A,B} -> ... <use A and B> ...
+%% end
+%%
+%% Rewrite this to:
+%%
+%% let <V1,V2> = case E of
+%% ... -> ... <Val1,Val2>
+%% ...
+%% end,
+%% in
+%% let <V> = {V1,V2}
+%% in case V of
+%% {A,B} -> ... <use A and B> ...
+%% end
+%%
+%% Note that the second 'case' is unchanged. The other optimizations
+%% in this module will eliminate the building of the tuple and
+%% rewrite the second case to:
+%%
+%% case <V1,V2> of
+%% <A,B> -> ... <use A and B> ...
+%% end
+%%
+
+opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) ->
+ case matches_data(Vs, B) of
+ {yes,TypeSig} ->
+ case delay_build(Arg0, TypeSig) of
+ no ->
+ Let0;
+ {yes,Vars,Arg,Data} ->
+ InnerLet = Let0#c_let{arg=Data},
+ Let0#c_let{vars=Vars,arg=Arg,body=InnerLet}
+ end;
+ no ->
+ Let0
+ end.
+
+matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V},
+ clauses=[#c_clause{pats=[P]}|_]}) ->
+ case cerl:is_data(P) of
+ false ->
+ no;
+ true ->
+ case cerl:data_type(P) of
+ {atomic,_} ->
+ no;
+ Type ->
+ {yes,{Type,cerl:data_arity(P)}}
+ end
+ end;
+matches_data(_, _) -> no.
+
+delay_build(Core, TypeSig) ->
+ case cerl:is_data(Core) of
+ true -> no;
+ false -> delay_build_1(Core, TypeSig)
+ end.
+
+delay_build_1(Core0, TypeSig) ->
+ try delay_build_expr(Core0, TypeSig) of
+ Core ->
+ {Type,Arity} = TypeSig,
+ Vars = make_vars([], Arity),
+ Data = cerl:ann_make_data([compiler_generated], Type, Vars),
+ {yes,Vars,Core,Data}
+ catch
+ throw:impossible ->
+ no
+ end.
+
+delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ C = C0#c_clause{body=B},
+ [C|delay_build_cs(Cs, TypeSig)];
+delay_build_cs([], _) -> [].
+
+delay_build_expr(Core, {Type,Arity}=TypeSig) ->
+ case cerl:is_data(Core) of
+ false ->
+ delay_build_expr_1(Core, TypeSig);
+ true ->
+ case {cerl:data_type(Core),cerl:data_arity(Core)} of
+ {Type,Arity} ->
+ core_lib:make_values(cerl:data_es(Core));
+ {_,_} ->
+ throw(impossible)
+ end
+ end.
+
+delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) ->
+ Cs = delay_build_cs(Cs0, TypeSig),
+ Case#c_case{clauses=Cs};
+delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ Let#c_let{body=B};
+delay_build_expr_1(#c_receive{clauses=Cs0,
+ timeout=Timeout,
+ action=A0}=Rec, TypeSig) ->
+ Cs = delay_build_cs(Cs0, TypeSig),
+ A = case Timeout of
+ #c_literal{val=infinity} -> A0;
+ _ -> delay_build_expr(A0, TypeSig)
+ end,
+ Rec#c_receive{clauses=Cs,action=A};
+delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) ->
+ B = delay_build_expr(B0, TypeSig),
+ Seq#c_seq{body=B};
+delay_build_expr_1(Core, _TypeSig) ->
+ case will_fail(Core) of
+ true -> Core;
+ false -> throw(impossible)
+ end.
+
%% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm
%% Optimize a let construct that does not contain any lets in
%% in its argument.
-opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) ->
- Arg = body(Arg0, value, Sub0), %This is a body
+opt_simple_let(Let0, Ctxt, Sub) ->
+ case opt_not_in_let(Let0) of
+ #c_let{}=Let ->
+ opt_simple_let_0(Let, Ctxt, Sub);
+ Expr ->
+ expr(Expr, Ctxt, Sub)
+ end.
+
+opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) ->
+ Arg = body(Arg0, value, Sub), %This is a body
case will_fail(Arg) of
true -> Arg;
- false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0)
+ false -> opt_simple_let_1(Let, Arg, Ctxt, Sub)
end.
opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
%% Optimise let and add new substitutions.
- {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
- BodySub = case {Vs,Args} of
- {[V],[A]} ->
- case is_bool_expr(A, Sub0) of
- true ->
- update_types(V, [#c_literal{val=true}], Sub1);
- false ->
- Sub1
- end;
- {_,_} -> Sub1
- end,
- B = body(B0, Ctxt, BodySub),
- Arg = core_lib:make_values(Args),
- opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1).
-
-opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) ->
+ {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
+ BodySub = update_let_types(Vs1, Args, Sub1),
+ B1 = body(B0, Ctxt, BodySub),
+ Arg1 = core_lib:make_values(Args),
+ {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1),
+ opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1).
+
+opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
case {Vs0,Arg0,Body} of
- {[#c_var{name=N1}],Arg,#c_var{name=N2}} ->
+ {[#c_var{name=N1}],Arg1,#c_var{name=N2}} ->
case N1 =:= N2 of
true ->
%% let <Var> = Arg in <Var> ==> Arg
- Arg;
+ Arg1;
false ->
%% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
+ Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt),
expr(#c_seq{arg=Arg,body=Body}, Ctxt,
sub_new_preserve_types(Sub))
end;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
- {_,Arg,#c_literal{}} ->
+ {Vs,Arg1,#c_literal{}} ->
+ Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt),
E = case Ctxt of
effect ->
%% Throw away the literal body.
@@ -2313,22 +2500,50 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) ->
#c_seq{arg=Arg,body=Body}
end,
expr(E, Ctxt, sub_new_preserve_types(Sub));
- {Vs,Arg,Body} ->
+ {Vs,Arg1,Body} ->
%% If none of the variables are used in the body, we can
%% rewrite the let to a sequence:
%% let <Var> = Arg in BodyWithoutVar ==>
%% seq Arg BodyWithoutVar
case is_any_var_used(Vs, Body) of
false ->
+ Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt),
expr(#c_seq{arg=Arg,body=Body}, Ctxt,
sub_new_preserve_types(Sub));
true ->
- Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body},
- Let2 = opt_case_in_let(Let1, Sub),
+ Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
+ Let2 = opt_bool_case_in_let(Let1, Sub),
opt_case_in_let_arg(Let2, Ctxt, Sub)
end
end.
+%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg'
+%% Try to suppress false warnings when a variable is not used.
+%% For instance, we don't expect a warning for useless building in:
+%%
+%% R = #r{}, %No warning expected.
+%% R#r.f %Optimization would remove the reference to R.
+%%
+%% To avoid false warnings, we will check whether the variables were
+%% referenced in the original unoptimized code. If they were, we will
+%% consider the warning false and suppress it.
+
+maybe_suppress_warnings(Arg, _, _, effect) ->
+ %% Don't suppress any warnings in effect context.
+ Arg;
+maybe_suppress_warnings(Arg, Vs, PrevBody, value) ->
+ case suppress_warning(Arg) of
+ true ->
+ Arg; %Already suppressed.
+ false ->
+ case is_any_var_used(Vs, PrevBody) of
+ true ->
+ cerl:set_ann(Arg, [compiler_generated]);
+ false ->
+ Arg
+ end
+ end.
+
move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg,
body=InnerArg0}=Outer,
clauses=InnerClauses}=Inner, Sub) ->
@@ -2416,7 +2631,7 @@ move_case_into_arg(_, _) ->
%% <> when 'true' ->
%% let <Var> = Literal2 in LetBody
%% end
-%%
+%%
%% In the worst case, the size of the code could increase.
%% In practice, though, substituting the literals into
%% LetBody and doing constant folding will decrease the code
@@ -2490,6 +2705,7 @@ is_boolean_type(Var, Sub) ->
is_int_type(Var, Sub) ->
case get_type(Var, Sub) of
none -> maybe;
+ integer -> yes;
C -> yes_no(cerl:is_c_int(C))
end.
@@ -2504,8 +2720,58 @@ is_tuple_type(Var, Sub) ->
yes_no(true) -> yes;
yes_no(false) -> no.
+%%%
+%%% Update type information.
+%%%
+
+update_let_types(Vs, Args, Sub) when is_list(Args) ->
+ update_let_types_1(Vs, Args, Sub);
+update_let_types(_Vs, _Arg, Sub) ->
+ %% The argument is a complex expression (such as a 'case')
+ %% that returns multiple values.
+ Sub.
+
+update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) ->
+ Sub = update_types_from_expr(V, A, Sub0),
+ update_let_types_1(Vs, As, Sub);
+update_let_types_1([], [], Sub) -> Sub.
+
+update_types_from_expr(V, Expr, Sub) ->
+ Type = extract_type(Expr, Sub),
+ update_types(V, [Type], Sub).
+
+extract_type(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=Name},
+ args=Args}=Call, Sub) ->
+ case returns_integer(Name, Args) of
+ true -> integer;
+ false -> extract_type_1(Call, Sub)
+ end;
+extract_type(Expr, Sub) ->
+ extract_type_1(Expr, Sub).
+
+extract_type_1(Expr, Sub) ->
+ case is_bool_expr(Expr, Sub) of
+ false -> Expr;
+ true -> bool
+ end.
+
+returns_integer(bit_size, [_]) -> true;
+returns_integer('bsl', [_,_]) -> true;
+returns_integer('bsr', [_,_]) -> true;
+returns_integer(byte_size, [_]) -> true;
+returns_integer(length, [_]) -> true;
+returns_integer('rem', [_,_]) -> true;
+returns_integer(size, [_]) -> true;
+returns_integer(tuple_size, [_]) -> true;
+returns_integer(trunc, [_]) -> true;
+returns_integer(_, _) -> false.
+
%% update_types(Expr, Pattern, Sub) -> Sub'
%% Update the type database.
+
+-spec update_types(cerl:cerl(), [type_info()], sub()) -> sub().
+
update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
Tdb = update_types_1(Expr, Pat, Tdb0),
Sub#sub{t=Tdb}.
@@ -2525,6 +2791,8 @@ update_types_2(V, [#c_tuple{}=P], Types) ->
orddict:store(V, P, Types);
update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
orddict:store(V, bool, Types);
+update_types_2(V, [Type], Types) when is_atom(Type) ->
+ orddict:store(V, Type, Types);
update_types_2(_, _, Types) -> Types.
%% kill_types(V, Tdb) -> Tdb'
@@ -2791,7 +3059,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) ->
bsm_problem(P, bin_partition)
end;
bsm_ensure_no_partition_after([], _) -> ok.
-
+
bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
bsm_could_match_binary(#c_cons{}) -> false;
bsm_could_match_binary(#c_tuple{}) -> false;
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index cbe50b93b0..7eec9dd62b 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -69,10 +69,8 @@
stk=[], %Stack table
res=[]}). %Reserved regs: [{reserved,I,V}]
-module({Mod,Exp,Attr,Forms}, Options) ->
- put(?MODULE, Options),
+module({Mod,Exp,Attr,Forms}, _Options) ->
{Fs,St} = functions(Forms, {atom,Mod}),
- erase(?MODULE),
{ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.
functions(Forms, AtomMod) ->
@@ -924,7 +922,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
select_map(Scs, V, Tf, Vf, Bef, St0) ->
Reg = fetch_var(V, Bef),
{Is,Aft,St1} =
- match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
+ match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
end, Vf, St0, Scs),
{[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 3c19a209c0..c954d21e59 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -78,7 +78,7 @@
splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
--import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1,
+-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1,
ann_c_map/3]).
-include("core_parse.hrl").
@@ -1660,48 +1660,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
-pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2};
-pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1};
-
-%% alias cons
-pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) ->
- pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}));
-pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
- pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}), Cons);
-pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) ->
- ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2));
-
-%% alias tuples
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) ->
- Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) ->
- Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) ->
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-
-%% alias maps
-%% There are no literals in maps patterns (patterns are always abstract)
-pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) ->
- M#c_map{es=pat_alias_map_pairs(Es1++Es2)};
-
-pat_alias(#c_alias{var=V1,pat=P1},
- #c_alias{var=V2,pat=P2}) ->
- if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)};
- true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}}
+pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P;
+pat_alias(#c_var{name=V1}=Var,
+ #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) ->
+ if
+ V1 =:= V2 ->
+ Alias;
+ true ->
+ Alias#c_alias{pat=pat_alias(Var, Pat)}
+ end;
+pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2};
+
+pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) ->
+ Alias;
+pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1},
+ #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) ->
+ Pat = pat_alias(P1, P2),
+ if
+ V1 =:= V2 ->
+ #c_alias{var=Var1,pat=Pat};
+ true ->
+ pat_alias(Var1, pat_alias(Var2, Pat))
end;
-pat_alias(#c_alias{var=V1,pat=P1}, P2) ->
- #c_alias{var=V1,pat=pat_alias(P1, P2)};
-pat_alias(P1, #c_alias{var=V2,pat=P2}) ->
- #c_alias{var=V2,pat=pat_alias(P1, P2)};
+pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) ->
+ #c_alias{var=Var,pat=pat_alias(P1, P2)};
+
+pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) ->
+ M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)};
+
+pat_alias(P1, #c_var{}=Var) ->
+ #c_alias{var=Var,pat=P1};
+pat_alias(P1, #c_alias{pat=P2}=Alias) ->
+ Alias#c_alias{pat=pat_alias(P1, P2)};
+
pat_alias(P1, P2) ->
- case {set_anno(P1, []),set_anno(P2, [])} of
- {P,P} -> P;
+ %% Aliases between binaries are not allowed, so the only
+ %% legal patterns that remain are data patterns.
+ case cerl:is_data(P1) andalso cerl:is_data(P2) of
+ false -> throw(nomatch);
+ true -> ok
+ end,
+ Type = cerl:data_type(P1),
+ case cerl:data_type(P2) of
+ Type -> ok;
_ -> throw(nomatch)
- end.
+ end,
+ Es1 = cerl:data_es(P1),
+ Es2 = cerl:data_es(P2),
+ Es = pat_alias_list(Es1, Es2),
+ cerl:make_data(Type, Es).
%% pat_alias_list([A1], [A2]) -> [A].
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index cd4b5fd674..75bd188479 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) ->
end,
Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0),
Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts],
- #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
+ #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs],
@@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
_ -> Ctxt0
end,
B = match(Kb, Ls1, I+1, Ctxt, Vdb1),
- #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
+ #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
@@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks].
%% literal_list([Klit]) -> [Lit].
literal(#k_var{name=N}, _) -> {var,N};
+literal(#k_literal{val=I}, _) -> {literal,I};
literal(#k_int{val=I}, _) -> {integer,I};
literal(#k_float{val=F}, _) -> {float,F};
literal(#k_atom{val=N}, _) -> {atom,N};
@@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil;
literal(#k_cons{hd=H,tl=T}, Ctxt) ->
{cons,[literal(H, Ctxt),literal(T, Ctxt)]};
literal(#k_binary{segs=V}, Ctxt) ->
- {binary,literal(V, Ctxt)};
+ {binary,literal(V, Ctxt)};
+literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
+ %% Only occurs in patterns.
+ {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]};
literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
{bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,
[literal(Seg, Ctxt),literal(N, Ctxt)]};
+literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
+ %% Only occurs in patterns.
+ {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int,
+ [literal(N, Ctxt)]};
literal(#k_bin_end{}, Ctxt) ->
{bin_end,Ctxt};
literal(#k_tuple{es=Es}, Ctxt) ->
{tuple,literal_list(Es, Ctxt)};
-literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) ->
- {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)};
+literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) ->
+ {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)};
literal(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal(K, Ctxt),literal(V, Ctxt)};
-literal(#k_literal{val=V}, _Ctxt) ->
- {literal,V}.
+ {map_pair,literal(K, Ctxt),literal(V, Ctxt)}.
literal_list(Ks, Ctxt) ->
[literal(K, Ctxt) || K <- Ks].
-literal2(#k_var{name=N}, _) -> {var,N};
-literal2(#k_literal{val=I}, _) -> {literal,I};
-literal2(#k_int{val=I}, _) -> {integer,I};
-literal2(#k_float{val=F}, _) -> {float,F};
-literal2(#k_atom{val=N}, _) -> {atom,N};
-%%literal2(#k_char{val=C}, _) -> {char,C};
-literal2(#k_nil{}, _) -> nil;
-literal2(#k_cons{hd=H,tl=T}, Ctxt) ->
- {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]};
-literal2(#k_binary{segs=V}, Ctxt) ->
- {binary,literal2(V, Ctxt)};
-literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
- {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]};
-literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
- {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,
- [literal2(Seg, Ctxt),literal2(N, Ctxt)]};
-literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
- {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int,
- [literal2(N, Ctxt)]};
-literal2(#k_bin_end{}, Ctxt) ->
- {bin_end,Ctxt};
-literal2(#k_tuple{es=Es}, Ctxt) ->
- {tuple,literal_list2(Es, Ctxt)};
-literal2(#k_map{op=Op,es=Es}, Ctxt) ->
- {map,Op,literal_list2(Es, Ctxt)};
-literal2(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}.
-
-literal_list2(Ks, Ctxt) ->
- [literal2(K, Ctxt) || K <- Ks].
-
-%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) ->
-%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]}
-
%% is_gc_bif(Name, Arity) -> true|false
%% Determines whether the BIF Name/Arity might do a GC.
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index 3199440d84..4d7f444c4f 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -370,6 +370,11 @@ combined(Config) when is_list(Config) ->
?line true = ?COMB(false, blurf, true),
?line true = ?COMB(true, true, blurf),
+ false = simple_comb(false, false),
+ false = simple_comb(false, true),
+ false = simple_comb(true, false),
+ true = simple_comb(true, true),
+
ok.
-undef(COMB).
@@ -396,6 +401,13 @@ comb(A, B, C) ->
end,
id(Res).
+simple_comb(A, B) ->
+ %% Use Res twice, to ensure that a careless optimization of 'not'
+ %% doesn't leave Res as a free variable.
+ Res = A andalso B,
+ _ = id(not Res),
+ Res.
+
%% Test that a boolean expression in a case expression is properly
%% optimized (in particular, that the error behaviour is correct).
in_case(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 512aada203..bc82eaf5aa 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -88,6 +88,7 @@ t_element(Config) when is_list(Config) ->
{_,_,_}=Tup ->
?line {'EXIT',{badarg,_}} = (catch element(4, Tup))
end,
+ {'EXIT',{badarg,_}} = (catch element(1, tuple_size(Tuple))),
ok.
@@ -106,6 +107,7 @@ setelement(Config) when is_list(Config) ->
?line error = setelement_crash_2({a,b,c,d,e,f}, <<42>>),
{'EXIT',{badarg,_}} = (catch setelement(1, not_a_tuple, New)),
+ {'EXIT',{badarg,_}} = (catch setelement(3, {a,b}, New)),
ok.
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index cfa8262701..1c9574c2a2 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -543,7 +543,7 @@ t_map_sort_literals(Config) when is_list(Config) ->
true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
- false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
+ true = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
%% value order
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 7522ee985f..9aec0b3d4e 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -141,6 +141,13 @@ aliases(Config) when is_list(Config) ->
?line {a,b} = list_alias2([a,b]),
?line {a,b} = list_alias3([a,b]),
+ %% Non-matching aliases.
+ none = mixed_aliases(<<42>>),
+ none = mixed_aliases([b]),
+ none = mixed_aliases([d]),
+ none = mixed_aliases({a,42}),
+ none = mixed_aliases(42),
+
ok.
str_alias(V) ->
@@ -244,6 +251,12 @@ list_alias2([X,Y]=[a,b]) ->
list_alias3([X,b]=[a,Y]) ->
{X,Y}.
+mixed_aliases(<<X:8>> = x) -> {a,X};
+mixed_aliases([b] = <<X:8>>) -> {b,X};
+mixed_aliases(<<X:8>> = {a,X}) -> {c,X};
+mixed_aliases([X] = <<X:8>>) -> {d,X};
+mixed_aliases(_) -> none.
+
%% OTP-7018.
match_in_call(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index dcd3910926..d0b7c71be8 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -39,7 +39,7 @@
guard/1,bad_arith/1,bool_cases/1,bad_apply/1,
files/1,effect/1,bin_opt_info/1,bin_construction/1,
comprehensions/1,maps/1,redundant_boolean_clauses/1,
- latin1_fallback/1,underscore/1]).
+ latin1_fallback/1,underscore/1,no_warnings/1]).
% Default timetrap timeout (set in init_per_testcase).
-define(default_timeout, ?t:minutes(2)).
@@ -65,7 +65,7 @@ groups() ->
bad_arith,bool_cases,bad_apply,files,effect,
bin_opt_info,bin_construction,comprehensions,maps,
redundant_boolean_clauses,latin1_fallback,
- underscore]}].
+ underscore,no_warnings]}].
init_per_suite(Config) ->
Config.
@@ -281,7 +281,6 @@ bad_arith(Config) when is_list(Config) ->
{3,sys_core_fold,{eval_failure,badarith}},
{9,sys_core_fold,nomatch_guard},
{9,sys_core_fold,{eval_failure,badarith}},
- {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}},
{10,sys_core_fold,nomatch_guard},
{10,sys_core_fold,{eval_failure,badarith}},
{15,sys_core_fold,{eval_failure,badarith}}
@@ -719,6 +718,27 @@ underscore(Config) when is_list(Config) ->
ok.
+no_warnings(Config) when is_list(Config) ->
+ Ts = [{no_warnings,
+ <<"-record(r, {s=ordsets:new(),a,b}).
+
+ a() ->
+ R = #r{}, %No warning expected.
+ {R#r.a,R#r.b}.
+
+ b(X) ->
+ T = true,
+ Var = [X], %No warning expected.
+ case T of
+ false -> Var;
+ true -> []
+ end.
+ ">>,
+ [],
+ []}],
+ run(Config, Ts),
+ ok.
+
%%%
%%% End of test cases.
%%%
diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl
index e525484a8e..b114d29f44 100644
--- a/lib/debugger/test/map_SUITE.erl
+++ b/lib/debugger/test/map_SUITE.erl
@@ -494,7 +494,7 @@ t_map_sort_literals(Config) when is_list(Config) ->
true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}),
true = #{ "a" => 1 } < id(#{ <<"a">> => 1}),
false = #{ <<"a">> => 1 } < id(#{ "a" => 1}),
- false = #{ 1 => 1 } < id(#{ 1.0 => 1}),
+ true = #{ 1 => 1 } < id(#{ 1.0 => 1}),
false = #{ 1.0 => 1 } < id(#{ 1 => 1}),
%% value order
@@ -587,12 +587,11 @@ t_bif_map_is_key(Config) when is_list(Config) ->
t_bif_map_keys(Config) when is_list(Config) ->
[] = maps:keys(#{}),
- [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}),
- [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}),
+ [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})),
+ [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})),
- % values in key order: [4,int,"hi",<<"key">>]
M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number},
- [4,int,"hi",<<"key">>] = maps:keys(M1),
+ [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)),
%% error case
{'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)),
@@ -634,40 +633,39 @@ t_bif_map_merge(Config) when is_list(Config) ->
ok.
-
t_bif_map_put(Config) when is_list(Config) ->
M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
4 => number, 18446744073709551629 => wat},
M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}),
- ["hi"] = maps:keys(M1),
- ["hello"] = maps:values(M1),
+ true = is_members(["hi"],maps:keys(M1)),
+ true = is_members(["hello"],maps:values(M1)),
M2 = #{ int := 3 } = maps:put(int, 3, M1),
- [int,"hi"] = maps:keys(M2),
- [3,"hello"] = maps:values(M2),
+ true = is_members([int,"hi"],maps:keys(M2)),
+ true = is_members([3,"hello"],maps:values(M2)),
M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2),
- [int,"hi",<<"key">>] = maps:keys(M3),
- [3,"hello",<<"value">>] = maps:values(M3),
+ true = is_members([int,"hi",<<"key">>],maps:keys(M3)),
+ true = is_members([3,"hello",<<"value">>],maps:values(M3)),
M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3),
- [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4),
- [wat,3,"hello",<<"value">>] = maps:values(M4),
+ true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)),
+ true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)),
M0 = #{ 4 := number } = M5 = maps:put(4, number, M4),
- [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5),
- [number,wat,3,"hello",<<"value">>] = maps:values(M5),
+ true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)),
+ true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)),
M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5),
- [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6),
- [number,wat,3,"hello",<<"other value">>] = maps:values(M6),
+ true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)),
+ true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)),
%% error case
{'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)),
@@ -675,46 +673,16 @@ t_bif_map_put(Config) when is_list(Config) ->
{'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)),
{'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])),
{'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)),
- ok.
-
-t_bif_map_remove(Config) when is_list(Config) ->
- 0 = erlang:map_size(maps:remove(some_key, #{})),
-
- M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
- 4 => number, 18446744073709551629 => wat},
-
- M1 = maps:remove("hi", M0),
- [4,18446744073709551629,int,<<"key">>] = maps:keys(M1),
- [number,wat,3,<<"value">>] = maps:values(M1),
-
- M2 = maps:remove(int, M1),
- [4,18446744073709551629,<<"key">>] = maps:keys(M2),
- [number,wat,<<"value">>] = maps:values(M2),
-
- M3 = maps:remove(<<"key">>, M2),
- [4,18446744073709551629] = maps:keys(M3),
- [number,wat] = maps:values(M3),
-
- M4 = maps:remove(18446744073709551629, M3),
- [4] = maps:keys(M4),
- [number] = maps:values(M4),
-
- M5 = maps:remove(4, M4),
- [] = maps:keys(M5),
- [] = maps:values(M5),
+ ok.
- M0 = maps:remove(5,M0),
- M0 = maps:remove("hi there",M0),
+is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false;
+is_members(Ks,Ls) -> is_members_do(Ks,Ls).
- #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)),
+is_members_do([],[]) -> true;
+is_members_do([],_) -> false;
+is_members_do([K|Ks],Ls) ->
+ is_members_do(Ks, lists:delete(K,Ls)).
- %% error case
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)),
- ok.
t_bif_map_update(Config) when is_list(Config) ->
M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
@@ -742,20 +710,57 @@ t_bif_map_update(Config) when is_list(Config) ->
ok.
+t_bif_map_remove(Config) when is_list(Config) ->
+ 0 = erlang:map_size(maps:remove(some_key, #{})),
+
+ M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+
+ M1 = maps:remove("hi", M0),
+ true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)),
+ true = is_members([number,wat,3,<<"value">>],maps:values(M1)),
+
+ M2 = maps:remove(int, M1),
+ true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)),
+ true = is_members([number,wat,<<"value">>],maps:values(M2)),
+
+ M3 = maps:remove(<<"key">>, M2),
+ true = is_members([4,18446744073709551629],maps:keys(M3)),
+ true = is_members([number,wat],maps:values(M3)),
+ M4 = maps:remove(18446744073709551629, M3),
+ true = is_members([4],maps:keys(M4)),
+ true = is_members([number],maps:values(M4)),
+
+ M5 = maps:remove(4, M4),
+ [] = maps:keys(M5),
+ [] = maps:values(M5),
+
+ M0 = maps:remove(5,M0),
+ M0 = maps:remove("hi there",M0),
+
+ #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)),
+
+ %% error case
+ {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)),
+ {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)),
+ {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)),
+ {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])),
+ {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)),
+ ok.
t_bif_map_values(Config) when is_list(Config) ->
[] = maps:values(#{}),
+ [1] = maps:values(#{a=>1}),
- [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}),
- [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}),
+ true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})),
+ true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})),
- % values in key order: [4,int,"hi",<<"key">>]
M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number},
M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> },
- [number,3,"hello2",<<"value2">>] = maps:values(M2),
- [number,3,"hello",<<"value">>] = maps:values(M1),
+ true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)),
+ true = is_members([number,3,"hello",<<"value">>],maps:values(M1)),
%% error case
{'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)),
@@ -764,75 +769,74 @@ t_bif_map_values(Config) when is_list(Config) ->
{'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)),
ok.
+
+
t_erlang_hash(Config) when is_list(Config) ->
ok = t_bif_erlang_phash2(),
ok = t_bif_erlang_phash(),
ok = t_bif_erlang_hash(),
-
ok.
t_bif_erlang_phash2() ->
-
39679005 = erlang:phash2(#{}),
- 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }),
- 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }),
- 14363616 = erlang:phash2(#{ 1 => a }),
- 51612236 = erlang:phash2(#{ a => 1 }),
+ 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764
+ 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230
+ 108954384 = erlang:phash2(#{ 1 => a }), % 14363616
+ 59617982 = erlang:phash2(#{ a => 1 }), % 51612236
- 37468437 = erlang:phash2(#{{} => <<>>}),
- 44049159 = erlang:phash2(#{<<>> => {}}),
+ 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437
+ 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159
M0 = #{ a => 1, "key" => <<"value">> },
M1 = maps:remove("key",M0),
M2 = M1#{ "key" => <<"value">> },
- 118679416 = erlang:phash2(M0),
- 51612236 = erlang:phash2(M1),
- 118679416 = erlang:phash2(M2),
+ 70249457 = erlang:phash2(M0), % 118679416
+ 59617982 = erlang:phash2(M1), % 51612236
+ 70249457 = erlang:phash2(M2), % 118679416
ok.
t_bif_erlang_phash() ->
Sz = 1 bsl 32,
- 268440612 = erlang:phash(#{},Sz),
- 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz),
- 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz),
- 1394238263 = erlang:phash(#{ 1 => a },Sz),
- 4066388227 = erlang:phash(#{ a => 1 },Sz),
+ 1113425985 = erlang:phash(#{},Sz), % 268440612
+ 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908
+ 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064
+ 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263
+ 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227
- 1578050717 = erlang:phash(#{{} => <<>>},Sz),
- 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken
+ 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717
+ 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717
M0 = #{ a => 1, "key" => <<"value">> },
M1 = maps:remove("key",M0),
M2 = M1#{ "key" => <<"value">> },
- 3590546636 = erlang:phash(M0,Sz),
- 4066388227 = erlang:phash(M1,Sz),
- 3590546636 = erlang:phash(M2,Sz),
+ 2620391445 = erlang:phash(M0,Sz), % 3590546636
+ 1670235874 = erlang:phash(M1,Sz), % 4066388227
+ 2620391445 = erlang:phash(M2,Sz), % 3590546636
ok.
t_bif_erlang_hash() ->
Sz = 1 bsl 27 - 1,
- 5158 = erlang:hash(#{},Sz),
- 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz),
- 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz),
- 126071654 = erlang:hash(#{ 1 => a },Sz),
- 126426236 = erlang:hash(#{ a => 1 },Sz),
+ 39684169 = erlang:hash(#{},Sz), % 5158
+ 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838
+ 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225
+ 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654
+ 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236
- 101655720 = erlang:hash(#{{} => <<>>},Sz),
- 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken
+ 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720
+ 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720
M0 = #{ a => 1, "key" => <<"value">> },
M1 = maps:remove("key",M0),
M2 = M1#{ "key" => <<"value">> },
- 38260486 = erlang:hash(M0,Sz),
- 126426236 = erlang:hash(M1,Sz),
- 38260486 = erlang:hash(M2,Sz),
+ 70254632 = erlang:hash(M0,Sz), % 38260486
+ 59623150 = erlang:hash(M1,Sz), % 126426236
+ 70254632 = erlang:hash(M2,Sz), % 38260486
ok.
-
t_map_encode_decode(Config) when is_list(Config) ->
<<131,116,0,0,0,0>> = erlang:term_to_binary(#{}),
Pairs = [
@@ -895,39 +899,42 @@ t_map_encode_decode(Config) when is_list(Config) ->
map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) ->
M1 = maps:put(K,V,M0),
B0 = erlang:term_to_binary(M1),
- Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]),
- %% sort Ks and Vs according to term spec, then match it
- KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls),
- ok = match_encoded_map(B0, length(Ls), KVbins),
+ Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs],
+ ok = match_encoded_map(B0, length(Ls), Ls),
%% decode and match it
M1 = erlang:binary_to_term(B0),
map_encode_decode_and_match(Pairs,Ls,M1);
map_encode_decode_and_match([],_,_) -> ok.
match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) ->
- match_encoded_map(Encoded,Items);
+ match_encoded_map_stripped_size(Encoded,Items,Items);
match_encoded_map(_,_,_) -> no_match_size.
-match_encoded_map(<<>>,[]) -> ok;
-match_encoded_map(Bin,[<<131,Item/binary>>|Items]) ->
- Size = erlang:byte_size(Item),
- <<EncodedTerm:Size/binary, Bin1/binary>> = Bin,
- EncodedTerm = Item, %% Asssert
- match_encoded_map(Bin1,Items).
+match_encoded_map_stripped_size(<<>>,_,_) -> ok;
+match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) ->
+ Ksz = byte_size(K),
+ Vsz = byte_size(V),
+ case B0 of
+ <<K:Ksz/binary,V:Vsz/binary,B1/binary>> ->
+ match_encoded_map_stripped_size(B1,Ls,Ls);
+ _ ->
+ match_encoded_map_stripped_size(B0,Items,Ls)
+ end;
+match_encoded_map_stripped_size(_,[],_) -> fail.
t_bif_map_to_list(Config) when is_list(Config) ->
[] = maps:to_list(#{}),
- [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}),
- [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}),
- [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}),
- [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}),
- [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{
- <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}),
-
- [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{
- <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5,
- <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}),
+ [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})),
+ [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})),
+ [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})),
+ [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})),
+ [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] =
+ lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})),
+
+ [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] =
+ lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5,
+ <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})),
%% error cases
{'EXIT', {badarg,_}} = (catch maps:to_list(id(a))),
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 336b4641d4..48d1ab9ebc 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -3519,6 +3519,7 @@ find_terminals(Tree) ->
'let' -> find_terminals(cerl:let_body(Tree));
letrec -> find_terminals(cerl:letrec_body(Tree));
literal -> {false, true};
+ map -> {false, true};
primop -> {false, false}; %% match_fail, etc. are not explicit exits.
'receive' ->
Timeout = cerl:receive_timeout(Tree),
diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc
index 0ced8cab32..3639bb43a5 100644
--- a/lib/edoc/doc/overview.edoc
+++ b/lib/edoc/doc/overview.edoc
@@ -78,7 +78,7 @@ The following are the main functions for running EDoc:
typical Erlang application.</li>
<li>{@link edoc:files/2}: Creates documentation for a
specified set of source files.</li>
- <li>{@link edoc:run/3}: General interface function; the common
+ <li>{@link edoc:run/2}: General interface function; the common
back-end for the above functions. Options are documented here.</li>
</ul>
diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl
index 78915e8943..88e7ab5346 100644
--- a/lib/edoc/src/edoc.erl
+++ b/lib/edoc/src/edoc.erl
@@ -313,7 +313,7 @@ opt_negations() ->
%% INHERIT-OPTIONS: target_dir_info/5
%% INHERIT-OPTIONS: edoc_lib:find_sources/2
%% INHERIT-OPTIONS: edoc_lib:run_doclet/2
-%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4
+%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3
run(Files, Opts0) ->
Opts = expand_opts(Opts0),
@@ -421,7 +421,7 @@ toc(Dir, Opts) ->
%% INHERIT-OPTIONS: init_context/1
%% INHERIT-OPTIONS: edoc_lib:run_doclet/2
-%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4
+%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3
toc(Dir, Paths, Opts0) ->
Opts = expand_opts(Opts0 ++ [{dir, Dir}]),
@@ -769,7 +769,7 @@ get_doc(File) ->
%% </dl>
%%
%% See {@link read_source/2}, {@link read_comments/2} and {@link
-%% edoc_lib:get_doc_env/4} for further options.
+%% edoc_lib:get_doc_env/3} for further options.
%%
%% @see get_doc/3
%% @see run/2
@@ -778,7 +778,7 @@ get_doc(File) ->
%% @see layout/2
%% INHERIT-OPTIONS: get_doc/3
-%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4
+%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3
get_doc(File, Opts) ->
Env = edoc_lib:get_doc_env(Opts),
@@ -790,7 +790,7 @@ get_doc(File, Opts) ->
%%
%% @doc Like {@link get_doc/2}, but for a given environment
%% parameter. `Env' is an environment created by {@link
-%% edoc_lib:get_doc_env/4}.
+%% edoc_lib:get_doc_env/3}.
%% INHERIT-OPTIONS: read_source/2, read_comments/2, edoc_extract:source/5
%% DEFER-OPTIONS: get_doc/2
diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl
index 6d34de3a85..758750083d 100644
--- a/lib/edoc/src/edoc_extract.erl
+++ b/lib/edoc/src/edoc_extract.erl
@@ -91,7 +91,7 @@ source(Forms, Comments, File, Env, Opts) ->
%% type `form_list', or a list of syntax trees representing
%% "program forms" (cf. {@link edoc:read_source/2}.
%% `Env' is an environment created by {@link
-%% edoc_lib:get_doc_env/4}. The `File' argument is used for
+%% edoc_lib:get_doc_env/3}. The `File' argument is used for
%% error reporting and output file name generation only.
%%
%% See {@link edoc:get_doc/2} for descriptions of the `def',
@@ -222,7 +222,7 @@ add_macro_defs(Defs0, Opts, Env) ->
%%
%% @doc Reads a text file and returns the list of tags in the file. Any
%% lines of text before the first tag are ignored. `Env' is an
-%% environment created by {@link edoc_lib:get_doc_env/4}. Upon error,
+%% environment created by {@link edoc_lib:get_doc_env/3}. Upon error,
%% `Reason' is an atom returned from the call to {@link
%% //kernel/file:read_file/1} or the atom 'invalid_unicode'.
%%
@@ -252,7 +252,7 @@ file(File, Context, Env, Opts) ->
%%
%% @doc Returns the list of tags in the text. Any lines of text before
%% the first tag are ignored. `Env' is an environment created by {@link
-%% edoc_lib:get_doc_env/4}.
+%% edoc_lib:get_doc_env/3}.
%%
%% See {@link source/4} for a description of the `def' option.
diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl
index 813fcf2476..c248964dc4 100644
--- a/lib/edoc/src/edoc_lib.erl
+++ b/lib/edoc/src/edoc_lib.erl
@@ -888,7 +888,7 @@ find_doc_dirs([]) ->
%% implies that we use the default app-path.
%% NEW-OPTIONS: doc_path
-%% DEFER-OPTIONS: get_doc_env/4
+%% DEFER-OPTIONS: get_doc_env/3
get_doc_links(App, Modules, Opts) ->
Path = proplists:append_values(doc_path, Opts) ++ find_doc_dirs(),
@@ -924,7 +924,7 @@ add_new(K, V, D) ->
end.
%% @spec (Options::proplist()) -> edoc_env()
-%% @equiv get_doc_env([], [], [], Opts)
+%% @equiv get_doc_env([], [], Opts)
%% @private
get_doc_env(Opts) ->
@@ -940,7 +940,7 @@ get_doc_env(Opts) ->
%% generating references. The data representation is not documented.
%%
%% @doc Creates an environment data structure used by parts of EDoc for
-%% generating references, etc. See {@link edoc:run/3} for a description
+%% generating references, etc. See {@link edoc:run/2} for a description
%% of the options `file_suffix', `app_default' and `doc_path'.
%%
%% @see edoc_extract:source/4
@@ -948,7 +948,7 @@ get_doc_env(Opts) ->
%% NEW-OPTIONS: file_suffix, app_default
%% INHERIT-OPTIONS: get_doc_links/4
-%% DEFER-OPTIONS: edoc:run/3
+%% DEFER-OPTIONS: edoc:run/2
get_doc_env(App, Modules, Opts) ->
Suffix = proplists:get_value(file_suffix, Opts,
@@ -967,10 +967,10 @@ get_doc_env(App, Modules, Opts) ->
%% ---------------------------------------------------------------------
%% Plug-in modules
-%% @doc See {@link edoc:run/3} for a description of the `doclet' option.
+%% @doc See {@link edoc:run/2} for a description of the `doclet' option.
%% NEW-OPTIONS: doclet
-%% DEFER-OPTIONS: edoc:run/3
+%% DEFER-OPTIONS: edoc:run/2
%% @private
run_doclet(Fun, Opts) ->
diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml
index b68115cd82..ed35ee3a9c 100644
--- a/lib/eldap/doc/src/eldap.xml
+++ b/lib/eldap/doc/src/eldap.xml
@@ -103,7 +103,7 @@ filter() See present/1, substrings/2,
<type>
<v>Handle = handle()</v>
<v>Options = ssl:ssl_options()</v>
- <v>Timeout = inifinity | positive_integer()</v>
+ <v>Timeout = infinity | positive_integer()</v>
</type>
<desc>
<p>Upgrade the connection associated with <c>Handle</c> to a tls connection if possible.</p>
diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk
index 432ba2e742..adca41ed63 100644
--- a/lib/eldap/vsn.mk
+++ b/lib/eldap/vsn.mk
@@ -1 +1 @@
-ELDAP_VSN = 1.1
+ELDAP_VSN = 1.1.1
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
index c27c682915..990d01e190 100644
--- a/lib/hipe/rtl/hipe_tagscheme.erl
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -109,6 +109,7 @@
-define(TAG_HEADER_REFC_BIN,((16#8 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
-define(TAG_HEADER_HEAP_BIN,((16#9 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
-define(TAG_HEADER_SUB_BIN, ((16#A bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_HASHMAP, ((16#B bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
-define(TAG_HEADER_EXTERNAL_PID, ((16#C bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
-define(TAG_HEADER_EXTERNAL_PORT,((16#D bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
-define(TAG_HEADER_EXTERNAL_REF, ((16#E bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
@@ -257,11 +258,16 @@ test_tuple_N(X, N, TrueLab, FalseLab, Pred) ->
test_map(X, TrueLab, FalseLab, Pred) ->
Tmp = hipe_rtl:mk_new_reg_gcsafe(),
HalfTrueLab = hipe_rtl:mk_new_label(),
+ OrHashmapLab = hipe_rtl:mk_new_label(),
MapMask = ?TAG_HEADER_MASK,
[test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
HalfTrueLab,
get_header(Tmp, X),
- mask_and_compare(Tmp, MapMask, ?TAG_HEADER_MAP, TrueLab, FalseLab, Pred)].
+ mask_and_compare(Tmp, MapMask, ?TAG_HEADER_MAP,
+ TrueLab, hipe_rtl:label_name(OrHashmapLab), Pred),
+ OrHashmapLab,
+ mask_and_compare(Tmp, MapMask, ?TAG_HEADER_HASHMAP, TrueLab, FalseLab, Pred)
+ ].
test_ref(X, TrueLab, FalseLab, Pred) ->
Hdr = hipe_rtl:mk_new_reg_gcsafe(),
@@ -360,16 +366,22 @@ test_matchstate(X, TrueLab, FalseLab, Pred) ->
test_bitstr(X, TrueLab, FalseLab, Pred) ->
Tmp = hipe_rtl:mk_new_reg_gcsafe(),
HalfTrueLab = hipe_rtl:mk_new_label(),
+ AndNotHashmapLab = hipe_rtl:mk_new_label(),
Mask = ?TAG_HEADER_MASK - ?BINARY_XXX_MASK,
[test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
HalfTrueLab,
get_header(Tmp, X),
- mask_and_compare(Tmp, Mask, ?TAG_HEADER_REFC_BIN, TrueLab, FalseLab, Pred)].
+ mask_and_compare(Tmp, Mask, ?TAG_HEADER_REFC_BIN,
+ hipe_rtl:label_name(AndNotHashmapLab), FalseLab, Pred),
+ AndNotHashmapLab,
+ mask_and_compare(Tmp, ?TAG_HEADER_MASK, ?TAG_HEADER_HASHMAP, FalseLab, TrueLab, Pred)
+ ].
test_binary(X, TrueLab, FalseLab, Pred) ->
Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
IsBoxedLab = hipe_rtl:mk_new_label(),
+ AndNotHashmapLab = hipe_rtl:mk_new_label(),
IsBitStrLab = hipe_rtl:mk_new_label(),
IsSubBinLab = hipe_rtl:mk_new_label(),
Mask = ?TAG_HEADER_MASK - ?BINARY_XXX_MASK,
@@ -377,7 +389,10 @@ test_binary(X, TrueLab, FalseLab, Pred) ->
IsBoxedLab,
get_header(Tmp1, X),
mask_and_compare(Tmp1, Mask, ?TAG_HEADER_REFC_BIN,
- hipe_rtl:label_name(IsBitStrLab), FalseLab, Pred),
+ hipe_rtl:label_name(AndNotHashmapLab), FalseLab, Pred),
+ AndNotHashmapLab,
+ mask_and_compare(Tmp1, ?TAG_HEADER_MASK, ?TAG_HEADER_HASHMAP,
+ FalseLab, hipe_rtl:label_name(IsBitStrLab), Pred),
IsBitStrLab,
mask_and_compare(Tmp1, ?TAG_HEADER_MASK, ?TAG_HEADER_SUB_BIN,
hipe_rtl:label_name(IsSubBinLab), TrueLab, 0.5),
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
index 31abf15d49..ccacbfe5c8 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
@@ -10,23 +10,25 @@ test() ->
false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}),
%% key order
- true = id(#{ a => 1 }) < id(#{ b => 1}),
- false = id(#{ b => 1 }) < id(#{ a => 1}),
- true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}),
- true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}),
- true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
- true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
- false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
- false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
- false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
+ true = #{ a => 1 } < id(#{ b => 1}),
+ false = #{ b => 1 } < id(#{ a => 1}),
+ true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}),
+ true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}),
+ true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}),
+ true = #{ "a" => 1 } < id(#{ <<"a">> => 1}),
+ false = #{ <<"a">> => 1 } < id(#{ "a" => 1}),
+ true = #{ 1 => 1 } < id(#{ 1.0 => 1}),
+ false = #{ 1.0 => 1 } < id(#{ 1 => 1}),
%% value order
- true = id(#{ a => 1 }) < id(#{ a => 2}),
- false = id(#{ a => 2 }) < id(#{ a => 1}),
- false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}),
- true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}),
+ true = #{ a => 1 } < id(#{ a => 2}),
+ false = #{ a => 2 } < id(#{ a => 1}),
+ false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}),
+ true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}),
+ false = #{ a => 1 } < id(#{ a => 1.0}),
+ false = #{ a => 1.0 } < id(#{ a => 1}),
- true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}),
+ true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}),
%% lists:sort
@@ -34,7 +36,6 @@ test() ->
[#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
-
ok.
%% Use this function to avoid compile-time evaluation of an expression.
diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl
index ed306a84f5..35778d3ed5 100644
--- a/lib/inets/src/http_client/httpc_cookie.erl
+++ b/lib/inets/src/http_client/httpc_cookie.erl
@@ -115,8 +115,8 @@ maybe_dets_close(Db) ->
%%--------------------------------------------------------------------
-%% Func: insert(CookieDb) -> ok
-%% Purpose: Close the cookie db
+%% Func: insert(CookieDb, Cookie) -> ok
+%% Purpose: insert cookies into the cookie db
%%--------------------------------------------------------------------
%% If no persistent cookie database is defined we
diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl
index 25ad34357a..3c4429129e 100644
--- a/lib/kernel/src/erl_distribution.erl
+++ b/lib/kernel/src/erl_distribution.erl
@@ -22,7 +22,6 @@
-export([start_link/0,start_link/1,init/1,start/1,stop/0]).
-%-define(DBG,io:format("~p:~p~n",[?MODULE,?LINE])).
-define(DBG,erlang:display([?MODULE,?LINE])).
start_link() ->
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index ef605d0bfe..17bee06b5e 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -33,7 +33,7 @@
-export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2,
dump_monitors/1, dump_links/1, flat_size/1,
get_internal_state/1, instructions/0, lock_counters/1,
- same/2, set_internal_state/2]).
+ map_info/1, same/2, set_internal_state/2]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -164,8 +164,10 @@ set_internal_state(_, _) ->
-spec size(term()) -> non_neg_integer().
+-record(s, {seen, maps}).
+
size(Term) ->
- {Sum,_} = size(Term, gb_trees:empty(), 0),
+ {Sum,_} = size(Term, #s{seen=gb_trees:empty(),maps=[]}, 0),
Sum.
size([H|T]=Term, Seen0, Sum0) ->
@@ -209,10 +211,24 @@ tuple_size(I, Sz, 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).
+ %% Danger:
+ %% The internal nodes from erts_internal:map_hashmap_children/1
+ %% is not allowed to leak anywhere. They are only allowed in
+ %% containers (cons cells and tuples, not maps), in gc and
+ %% in erts_debug:same/2
+ case erts_internal:map_type(Map) of
+ flatmap ->
+ 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);
+ hashmap ->
+ Cs = erts_internal:map_hashmap_children(Map),
+ fold_size(Cs,Seen0,Sum0+length(Cs)+2);
+ hashmap_node ->
+ Cs = erts_internal:map_hashmap_children(Map),
+ fold_size(Cs,Seen0,Sum0+length(Cs)+1)
+ end.
fun_size(Fun, Seen, Sum) ->
case erlang:fun_info(Fun, type) of
@@ -229,13 +245,18 @@ fold_size([H|T], Seen0, Sum0) ->
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);
+remember_term(Term, #s{maps=Ms}=S) when is_map(Term) ->
+ case is_term_seen(Term, Ms) of
+ false -> S#s{maps=[Term|Ms]};
+ true -> seen
+ end;
+remember_term(Term, #s{seen=T}=S) ->
+ case gb_trees:lookup(Term,T) of
+ none -> S#s{seen=gb_trees:insert(Term,[Term],T)};
{value,Terms} ->
case is_term_seen(Term, Terms) of
- false -> gb_trees:update(Term, [Term|Terms], Seen);
- true -> seen
+ false -> S#s{seen=gb_trees:update(Term,[Term|Terms],T)};
+ true -> seen
end
end.
@@ -313,3 +334,9 @@ cont_dis(File, {Addr,Str,MFA}, MFA) ->
io:put_chars(File, binary_to_list(Str)),
cont_dis(File, erts_debug:disassemble(Addr), MFA);
cont_dis(_, {_,_,_}, _) -> ok.
+
+-spec map_info(Map) -> list() when
+ Map :: map().
+
+map_info(_) ->
+ erlang:nif_error(undef).
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index 849013ac79..44a32fc1ec 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -88,10 +88,30 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_testcase(lookup_bad_search_option, Config) ->
+ Db = inet_db,
+ Key = res_lookup,
+ %% The bad option can not enter through inet_db:set_lookup/1,
+ %% but through e.g .inetrc.
+ Prev = ets:lookup(Db, Key),
+ ets:delete(Db, Key),
+ ets:insert(Db, {Key,[lookup_bad_search_option]}),
+ ?t:format("Misconfigured resolver lookup order", []),
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ [{Key,Prev},{watchdog,Dog}|Config];
init_per_testcase(_Func, Config) ->
Dog = test_server:timetrap(test_server:seconds(60)),
[{watchdog,Dog}|Config].
+end_per_testcase(lookup_bad_search_option, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ Db = inet_db,
+ Key = res_lookup,
+ Prev = ?config(Key, Config),
+ ets:delete(Db, Key),
+ ets:insert(Db, Prev),
+ ?t:format("Restored resolver lookup order", []);
end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog).
@@ -915,10 +935,8 @@ lookup_bad_search_option(suite) ->
lookup_bad_search_option(doc) ->
["Test lookup with erroneously configured lookup option (OTP-12133)"];
lookup_bad_search_option(Config) when is_list(Config) ->
- Db = inet_db,
- %% The bad option can not enter through inet_db:set_lookup/1,
- %% but through e.g .inetrc.
- ets:insert(Db, {res_lookup,[lookup_bad_search_option]}),
+ %% Manipulation of resolver config is done in init_per_testcase
+ %% and end_per_testcase to ensure cleanup.
{ok,Hostname} = inet:gethostname(),
{ok,_Hent} = inet:gethostbyname(Hostname), % Will hang loop for this bug
ok.
diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
index e99151284f..41c19fce51 100644
--- a/lib/kernel/test/zlib_SUITE.erl
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -146,8 +146,6 @@ api_deflateInit(Config) when is_list(Config) ->
?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)),
?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)),
?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)),
- ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-8,8,default)),
- ?m(?BARG, zlib:deflateInit(Z1,default,deflated,8,8,default)),
?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)),
?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)),
@@ -169,7 +167,7 @@ api_deflateInit(Config) when is_list(Config) ->
?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)),
?m(ok,zlib:close(Z11)),
?m(ok,zlib:close(Z12))
- end, lists:seq(9, 15)),
+ end, lists:seq(8, 15)),
lists:foreach(fun(MemLevel) ->
?line Z = zlib:open(),
@@ -277,7 +275,7 @@ api_inflateInit(Config) when is_list(Config) ->
?m(ok, zlib:inflateInit(Z12,-Wbits)),
?m(ok,zlib:close(Z11)),
?m(ok,zlib:close(Z12))
- end, lists:seq(9,15)),
+ end, lists:seq(8,15)),
?m(?BARG, zlib:inflateInit(gurka, -15)),
?m(?BARG, zlib:inflateInit(Z1, 7)),
?m(?BARG, zlib:inflateInit(Z1, -7)),
diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl
index 237984978e..f906670296 100644
--- a/lib/mnesia/test/mnesia_trans_access_test.erl
+++ b/lib/mnesia/test/mnesia_trans_access_test.erl
@@ -930,20 +930,20 @@ index_update_bag(Config)when is_list(Config) ->
[IPos] = mnesia_lib:val({Tab,index}),
ITab = mnesia_lib:val({index_test,{index, IPos}}),
io:format("~n Index ~p @ ~p => ~p ~n~n",[IPos,ITab, ets:tab2list(ITab)]),
- ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)),
+ ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))),
?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec5) end)),
{atomic, R60} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end),
?match([Rec1,Rec5,Rec2], lists:sort(R60)),
- ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)),
+ ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))),
?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:delete_object(Rec3) end)),
{atomic, R61} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end),
?match([Rec1,Rec5,Rec2], lists:sort(R61)),
{atomic, R62} = mnesia:transaction(fun() -> mnesia:index_read(Tab,12, ValPos) end),
?match([], lists:sort(R62)),
- ?match([{2,1},{2,2}], ets:tab2list(ITab)),
+ ?match([{2,1},{2,2}], lists:keysort(1,ets:tab2list(ITab))),
%% reset for rest of testcase
?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec3) end)),
diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl
index 1f088ecbde..66e7973e7e 100644
--- a/lib/os_mon/src/cpu_sup.erl
+++ b/lib/os_mon/src/cpu_sup.erl
@@ -221,7 +221,7 @@ get_uint32_measurement(Request, #internal{port = P, os_type = {unix, sunos}}) ->
port_server_call(P, Request);
get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) ->
{ok,F} = file:open("/proc/loadavg",[read,raw]),
- {ok,D} = file:read(F,24),
+ {ok,D} = file:read_line(F),
ok = file:close(F),
{ok,[Load1,Load5,Load15,_PRun,PTotal],_} = io_lib:fread("~f ~f ~f ~d/~d", D),
case Request of
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index a0a87e5351..e8ff965982 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -114,7 +114,7 @@ pem_encode(PemEntries) when is_list(PemEntries) ->
iolist_to_binary(pubkey_pem:encode(PemEntries)).
%%--------------------------------------------------------------------
--spec pem_entry_decode(pem_entry(), [string()]) -> term().
+-spec pem_entry_decode(pem_entry(), string()) -> term().
%
%% Description: Decodes a pem entry. pem_decode/1 returns a list of
%% pem entries.
@@ -146,14 +146,16 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry,
pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry,
Password) when is_atom(Asn1Type) andalso
is_binary(CryptDer) andalso
- is_list(Cipher) ->
+ is_list(Cipher) andalso
+ is_list(Password) ->
do_pem_entry_decode(PemEntry, Password);
pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry,
Password) when is_atom(Asn1Type) andalso
is_binary(CryptDer) andalso
is_list(Cipher) andalso
is_binary(Salt) andalso
- ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) ->
+ ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) andalso
+ is_list(Password) ->
do_pem_entry_decode(PemEntry, Password).
@@ -626,8 +628,12 @@ pkix_is_fixed_dh_cert(Cert) when is_binary(Cert) ->
%
%% Description: Returns the issuer id.
%%--------------------------------------------------------------------
-pkix_issuer_id(Cert, Signed)->
- pkix_issuer_id(Cert, Signed, decode).
+pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed) when (Signed == self) or
+ (Signed == other) ->
+ pubkey_cert:issuer_id(OtpCert, Signed);
+pkix_issuer_id(Cert, Signed) when is_binary(Cert) ->
+ OtpCert = pkix_decode_cert(Cert, otp),
+ pkix_issuer_id(OtpCert, Signed).
%%--------------------------------------------------------------------
-spec pkix_crl_issuer(CRL::binary()| #'CertificateList'{}) ->
@@ -990,17 +996,3 @@ ec_key({PubKey, PrivateKey}, Params) ->
parameters = Params,
publicKey = {0, PubKey}}.
-pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, decode) when (Signed == self) or
- (Signed == other) ->
- pubkey_cert:issuer_id(OtpCert, Signed);
-pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, encode) when (Signed == self) or
- (Signed == other) ->
- case pubkey_cert:issuer_id(OtpCert, Signed) of
- {ok, {Serial, Issuer}} ->
- {ok, {Serial, pubkey_cert_records:transform(Issuer, encode)}};
- Error ->
- Error
- end;
-pkix_issuer_id(Cert, Signed, Decode) when is_binary(Cert) ->
- OtpCert = pkix_decode_cert(Cert, otp),
- pkix_issuer_id(OtpCert, Signed, Decode).
diff --git a/lib/ssh/examples/Makefile b/lib/ssh/examples/Makefile
index de019f75b5..9280c42076 100644
--- a/lib/ssh/examples/Makefile
+++ b/lib/ssh/examples/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2012. All Rights Reserved.
+# Copyright Ericsson AB 2005-2015. 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
@@ -38,7 +38,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN)
MODULES = \
- ssh_sample_cli
+ ssh_sample_cli \
+ ssh_device.erl
ERL_FILES= $(MODULES:=.erl)
diff --git a/lib/ssh/examples/ssh_device.erl b/lib/ssh/examples/ssh_device.erl
new file mode 100644
index 0000000000..f6be812915
--- /dev/null
+++ b/lib/ssh/examples/ssh_device.erl
@@ -0,0 +1,62 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2015. 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(ssh_device).
+
+%% api
+-export([ssh_device/5]).
+
+%%% I wrote this because of i think a fully ssh client sample will be easy to start the ssh module better than
+%%% go though each function file.
+ssh_device(Host, Port, User, Pass, Cmd) ->
+ ssh:start(),
+ case ssh:connect(Host, Port,
+ [{user, User}, {password, Pass},
+ {silently_accept_hosts, true}, {quiet_mode, true}])
+ of
+ {ok, Conn} ->
+ {ok, ChannelId} = ssh_connection:session_channel(Conn,
+ infinity),
+ ssh_connection:exec(Conn, ChannelId, Cmd, infinity),
+ Init_rep = <<>>,
+ wait_for_response(Conn, Host, Init_rep),
+ ssh:close(Conn);
+ {error, nxdomain} ->
+ {error,nxdomain}
+ end.
+
+%%--------------------------------------------------------------------
+%%% Internal application API
+%%--------------------------------------------------------------------
+wait_for_response(Conn, Host, Acc) ->
+ receive
+ {ssh_cm, Conn, Msg} ->
+ case Msg of
+ {closed, _ChannelId} ->
+ {ok,Acc};
+ {data, _, _, A} ->
+ Acc2 = <<Acc/binary, A/binary>>,
+ wait_for_response(Conn, Host, Acc2);
+ _ ->
+ wait_for_response(Conn, Host, Acc)
+ end
+ after
+ 5000 ->
+ {error,timeout}
+ end.
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index c8cac3e852..bfebe2c60b 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 3.1
+SSH_VSN = 3.1.1
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index c9b02d44ec..47b0dbc206 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -89,12 +89,14 @@
|{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} |
{user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}} |
{ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()}
+ {alpn_advertised_protocols, [binary()]} |
+ {alpn_preferred_protocols, [binary()]} |
{next_protocols_advertised, [binary()]} |
{client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}} |
{log_alert, boolean()} | {server_name_indication, hostname() | disable}
</c></p>
- <p><c>transportoption() = {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}}
+ <p><c>transportoption() = {cb_info, {CallbackModule :: atom(), DataTag :: atom(), ClosedTag :: atom(), ErrTag:atom()}}
- defaults to {gen_tcp, tcp, tcp_closed, tcp_error}. Can be used to customize
the transport layer. The callback module must implement a reliable transport
protocol and behave as gen_tcp and in addition have functions corresponding to
@@ -303,20 +305,20 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo
</taglist>
</item>
- <tag>{crl_check, boolean() | peer | best_effort )</tag>
+ <tag>{crl_check, boolean() | peer | best_effort }</tag>
<item>
Perform CRL (Certificate Revocation List) verification
<seealso marker="public_key:public_key#pkix_crl_validate-3">
- public_key:pkix_crls_validate/3</seealso>, during the
+ (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation
<seealso
- marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3 </seealso>
- invokation on all the certificates in the peer certificate chain. Defaults to
- false.
-
+ marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3)
+ </seealso>
+ of the certificate chain. Defaults to false.
+
<p><c>peer</c> - check is only performed on
the peer certificate.</p>
- <p><c>best_effort</c> - if certificate revokation status can not be determined
+ <p><c>best_effort</c> - if certificate revocation status can not be determined
it will be accepted as valid.</p>
<p>The CA certificates specified for the connection will be used to
@@ -326,7 +328,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo
<seealso marker="ssl:ssl_crl_cache_api">ssl_crl_cache_api(3)</seealso>.</p>
</item>
- <tag>{crl_cache, {Module::atom, {DbHandle::internal | term(), Args::list()}}</tag>
+ <tag>{crl_cache, {Module :: atom(), {DbHandle :: internal | term(), Args :: list()}}}</tag>
<item>
<p>Module defaults to ssl_crl_cache with <c> DbHandle </c> internal and an
empty argument list. The following arguments may be specified for the internal cache.</p>
@@ -425,7 +427,20 @@ fun(srp, Username :: string(), UserState :: term()) ->
certificates are used during server authentication and when building the
client certificate chain.
</item>
-
+
+ <tag>{alpn_advertised_protocols, [binary()]}</tag>
+ <item>
+ <p>The list of protocols supported by the client to be sent to the
+ server to be used for an Application-Layer Protocol Negotiation (ALPN).
+ If the server supports ALPN then it will choose a protocol from this
+ list; otherwise it will fail the connection with a "no_application_protocol"
+ alert. A server that does not support ALPN will ignore this value.</p>
+
+ <p>The list of protocols must not contain an empty binary.</p>
+
+ <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p>
+ </item>
+
<tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</tag>
<tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</tag>
<item>
@@ -545,12 +560,25 @@ fun(srp, Username :: string(), UserState :: term()) ->
and CipherSuite is of type ciphersuite().
</item>
+ <tag>{alpn_preferred_protocols, [binary()]}</tag>
+ <item>
+ <p>Indicates the server will try to perform Application-Layer
+ Protocol Negotiation (ALPN).</p>
+
+ <p>The list of protocols is in order of preference. The protocol
+ negotiated will be the first in the list that matches one of the
+ protocols advertised by the client. If no protocol matches, the
+ server will fail the connection with a "no_application_protocol" alert.</p>
+
+ <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p>
+ </item>
+
<tag>{next_protocols_advertised, Protocols :: [binary()]}</tag>
<item>The list of protocols to send to the client if the client indicates
it supports the Next Protocol extension. The client may select a protocol
that is not on this list. The list of protocols must not contain an empty
binary. If the server negotiates a Next Protocol it can be accessed
- using <c>negotiated_next_protocol/1</c> method.
+ using <c>negotiated_protocol/1</c> function.
</item>
<tag>{psk_identity, string()}</tag>
@@ -1018,15 +1046,15 @@ fun(srp, Username :: string(), UserState :: term()) ->
</desc>
</func>
<func>
- <name>negotiated_next_protocol(Socket) -> {ok, Protocol} | {error, next_protocol_not_negotiated}</name>
- <fsummary>Returns the Next Protocol negotiated.</fsummary>
+ <name>negotiated_protocol(Socket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name>
+ <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary>
<type>
<v>Socket = sslsocket()</v>
<v>Protocol = binary()</v>
</type>
<desc>
<p>
- Returns the Next Protocol negotiated.
+ Returns the protocol negotiated through ALPN or NPN extensions.
</p>
</desc>
</func>
diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml
index 1ed76d3e2a..b291c7b633 100644
--- a/lib/ssl/doc/src/ssl_crl_cache.xml
+++ b/lib/ssl/doc/src/ssl_crl_cache.xml
@@ -29,7 +29,7 @@
<p>
Implements an internal CRL (Certificate Revocation List) cache.
In addition to implementing the <seealso
- marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso>
+ marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso> behaviour
the following functions are available.
</p>
</description>
diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml
index 24365c9f59..3f518496be 100644
--- a/lib/ssl/doc/src/ssl_crl_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml
@@ -27,13 +27,15 @@
<modulesummary>API for a SSL/TLS CRL (Certificate Revocation List) cache.</modulesummary>
<description>
<p>
- When SSL/TLS performs certificate path validation according to
- <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> it should
- also perform CRL validation checks. To enable the CRL checks the application
- needs access to CRLs. A database of CRLs can be set up in many different ways.
- This module provides an API to integrate an arbitrary CRL cache with the erlang
- ssl application. It is also used by the application itself to provide a simple
- default implementation of a CRL cache.
+ When SSL/TLS performs certificate path validation according to
+ <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url>
+ it should also perform CRL validation checks. To enable the CRL
+ checks the application needs access to CRLs. A database of CRLs
+ can be set up in many different ways. This module provides the
+ behavior of the API needed to integrate an arbitrary CRL cache
+ with the erlang ssl application. It is also used by the
+ application itself to provide a simple default implementation of
+ a CRL cache.
</p>
</description>
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 508983ddac..610e2c4e41 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2015. 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,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) ->
Handshake = ssl_handshake:init_handshake_history(),
TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
try ssl_config:init(SSLOpts0, Role) of
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} ->
+ {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} ->
Session = State0#state.session,
State = State0#state{
tls_handshake_history = Handshake,
@@ -155,6 +155,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) ->
file_ref_db = FileRefHandle,
cert_db_ref = Ref,
cert_db = CertDbHandle,
+ crl_db = CRLDbInfo,
session_cache = CacheHandle,
private_key = Key,
diffie_hellman_params = DHParams},
@@ -227,9 +228,9 @@ hello(Hello,
case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
handle_own_alert(Alert, ReqVersion, hello, State);
- {Version, NewId, ConnectionStates, NextProtocol} ->
+ {Version, NewId, ConnectionStates, ProtoExt, Protocol} ->
ssl_connection:handle_session(Hello,
- Version, NewId, ConnectionStates, NextProtocol, State)
+ Version, NewId, ConnectionStates, ProtoExt, Protocol, State)
end;
hello(Msg, State) ->
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index 31d525b295..30381df050 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -181,8 +181,8 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
SslOpt, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
Alert;
- {ConnectionStates, Protocol} ->
- {Version, SessionId, ConnectionStates, Protocol}
+ {ConnectionStates, ProtoExt, Protocol} ->
+ {Version, SessionId, ConnectionStates, ProtoExt, Protocol}
end.
dtls_fragment(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc)
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 623fa92121..6461f64c1c 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -38,10 +38,12 @@
%% SSL/TLS protocol handling
-export([cipher_suites/0, cipher_suites/1, suite_definition/1,
connection_info/1, versions/0, session_info/1, format_error/1,
- renegotiate/1, prf/5, negotiated_next_protocol/1]).
+ renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1]).
%% Misc
-export([random_bytes/1]).
+-deprecated({negotiated_next_protocol, 1, next_major_release}).
+
-include("ssl_api.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
@@ -330,13 +332,27 @@ suite_definition(S) ->
{KeyExchange, Cipher, Hash}.
%%--------------------------------------------------------------------
+-spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
+%%
+%% Description: Returns the protocol that has been negotiated. If no
+%% protocol has been negotiated will return {error, protocol_not_negotiated}
+%%--------------------------------------------------------------------
+negotiated_protocol(#sslsocket{pid = Pid}) ->
+ ssl_connection:negotiated_protocol(Pid).
+
+%%--------------------------------------------------------------------
-spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
%%
%% Description: Returns the next protocol that has been negotiated. If no
%% protocol has been negotiated will return {error, next_protocol_not_negotiated}
%%--------------------------------------------------------------------
-negotiated_next_protocol(#sslsocket{pid = Pid}) ->
- ssl_connection:negotiated_next_protocol(Pid).
+negotiated_next_protocol(Socket) ->
+ case negotiated_protocol(Socket) of
+ {error, protocol_not_negotiated} ->
+ {error, next_protocol_not_negotiated};
+ Res ->
+ Res
+ end.
%%--------------------------------------------------------------------
-spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] |
@@ -644,6 +660,10 @@ handle_options(Opts0) ->
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
hibernate_after = handle_option(hibernate_after, Opts, undefined),
erl_dist = handle_option(erl_dist, Opts, false),
+ alpn_advertised_protocols =
+ handle_option(alpn_advertised_protocols, Opts, undefined),
+ alpn_preferred_protocols =
+ handle_option(alpn_preferred_protocols, Opts, undefined),
next_protocols_advertised =
handle_option(next_protocols_advertised, Opts, undefined),
next_protocol_selector =
@@ -667,7 +687,8 @@ handle_options(Opts0) ->
user_lookup_fun, psk_identity, srp_identity, ciphers,
reuse_session, reuse_sessions, ssl_imp,
cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
- erl_dist, next_protocols_advertised,
+ erl_dist, alpn_advertised_protocols,
+ alpn_preferred_protocols, next_protocols_advertised,
client_preferred_next_protocols, log_alert,
server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache,
fallback],
@@ -803,6 +824,20 @@ validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
Value;
validate_option(erl_dist,Value) when is_boolean(Value) ->
Value;
+validate_option(Opt, Value)
+ when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols,
+ is_list(Value) ->
+ case tls_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(Opt, Value),
+ Value
+ end;
+validate_option(Opt, Value)
+ when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols,
+ Value =:= undefined ->
+ undefined;
validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value)
when is_list(PreferredProtocols) ->
case tls_record:highest_protocol_version([]) of
@@ -1131,6 +1166,10 @@ new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, Rec
new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB);
new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB);
+new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{alpn_advertised_protocols = validate_option(alpn_advertised_protocols, Value)}, RecordCB);
+new_ssl_options([{alpn_preferred_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{alpn_preferred_protocols = validate_option(alpn_preferred_protocols, Value)}, RecordCB);
new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB);
new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index 9e372f739a..c46facb75d 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -163,5 +163,7 @@ description_txt(?UNKNOWN_PSK_IDENTITY) ->
"unknown psk identity";
description_txt(?INAPPROPRIATE_FALLBACK) ->
"inappropriate fallback";
+description_txt(?NO_APPLICATION_PROTOCOL) ->
+ "no application protocol";
description_txt(Enum) ->
lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])).
diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl
index a3619e4a35..70b7523975 100644
--- a/lib/ssl/src/ssl_alert.hrl
+++ b/lib/ssl/src/ssl_alert.hrl
@@ -69,6 +69,8 @@
%% bad_certificate_hash_value(114),
%% RFC 4366
%% unknown_psk_identity(115),
+%% RFC 7301
+%% no_application_protocol(120),
%% (255)
%% } AlertDescription;
@@ -103,6 +105,7 @@
-define(BAD_CERTIFICATE_STATUS_RESPONSE, 113).
-define(BAD_CERTIFICATE_HASH_VALUE, 114).
-define(UNKNOWN_PSK_IDENTITY, 115).
+-define(NO_APPLICATION_PROTOCOL, 120).
-define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}).
diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl
index 22185ff60a..78127eeafa 100644
--- a/lib/ssl/src/ssl_api.hrl
+++ b/lib/ssl/src/ssl_api.hrl
@@ -49,6 +49,8 @@
{srp_identity, {string(), string()}} |
{ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} |
{reuse_session, fun()} | {hibernate_after, integer()|undefined} |
+ {alpn_advertised_protocols, [binary()]} |
+ {alpn_preferred_protocols, [binary()]} |
{next_protocols_advertised, list(binary())} |
{client_preferred_next_protocols, binary(), client | server, list(binary())}.
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index 764bd82de0..34e4a8b447 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -84,7 +84,7 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -
end.
%%--------------------------------------------------------------------
--spec certificate_chain(undefined | binary(), db_handle(), certdb_ref()) ->
+-spec certificate_chain(undefined | binary() | #'OTPCertificate'{} , db_handle(), certdb_ref()) ->
{error, no_cert} | {ok, #'OTPCertificate'{} | undefined, [der_cert()]}.
%%
%% Description: Return the certificate chain to send to peer.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 08d0145aa7..4a839872a6 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -42,10 +42,10 @@
%% User Events
-export([send/2, recv/3, close/1, shutdown/2,
new_user/2, get_opts/2, set_opts/2, info/1, session_info/1,
- peer_certificate/1, renegotiation/1, negotiated_next_protocol/1, prf/5
+ peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5
]).
--export([handle_session/6]).
+-export([handle_session/7]).
%% SSL FSM state functions
-export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]).
@@ -191,12 +191,12 @@ new_user(ConnectionPid, User) ->
sync_send_all_state_event(ConnectionPid, {new_user, User}).
%%--------------------------------------------------------------------
--spec negotiated_next_protocol(pid()) -> {ok, binary()} | {error, reason()}.
+-spec negotiated_protocol(pid()) -> {ok, binary()} | {error, reason()}.
%%
%% Description: Returns the negotiated protocol
%%--------------------------------------------------------------------
-negotiated_next_protocol(ConnectionPid) ->
- sync_send_all_state_event(ConnectionPid, negotiated_next_protocol).
+negotiated_protocol(ConnectionPid) ->
+ sync_send_all_state_event(ConnectionPid, negotiated_protocol).
%%--------------------------------------------------------------------
-spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}.
@@ -258,27 +258,26 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) ->
handle_session(#server_hello{cipher_suite = CipherSuite,
compression_method = Compression},
- Version, NewId, ConnectionStates, NextProtocol,
+ Version, NewId, ConnectionStates, ProtoExt, Protocol0,
#state{session = #session{session_id = OldId},
- negotiated_version = ReqVersion} = State0) ->
+ negotiated_version = ReqVersion,
+ negotiated_protocol = CurrentProtocol} = State0) ->
{KeyAlgorithm, _, _, _} =
ssl_cipher:suite_definition(CipherSuite),
PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm),
-
- NewNextProtocol = case NextProtocol of
- undefined ->
- State0#state.next_protocol;
- _ ->
- NextProtocol
- end,
-
+
+ {ExpectNPN, Protocol} = case Protocol0 of
+ undefined -> {false, CurrentProtocol};
+ _ -> {ProtoExt =:= npn, Protocol0}
+ end,
+
State = State0#state{key_algorithm = KeyAlgorithm,
negotiated_version = Version,
connection_states = ConnectionStates,
premaster_secret = PremasterSecret,
- expecting_next_protocol_negotiation = NextProtocol =/= undefined,
- next_protocol = NewNextProtocol},
+ expecting_next_protocol_negotiation = ExpectNPN,
+ negotiated_protocol = Protocol},
case ssl_session:is_new(OldId, NewId) of
true ->
@@ -371,7 +370,7 @@ abbreviated(#finished{verify_data = Data} = Finished,
abbreviated(#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}),
+ {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}),
Connection:next_state(abbreviated, abbreviated, Record, State#state{expecting_next_protocol_negotiation = false});
abbreviated(timeout, State, _) ->
@@ -593,7 +592,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS
%% client must send a next protocol message if we are expecting it
cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true,
- next_protocol = undefined, negotiated_version = Version} = State0,
+ negotiated_protocol = undefined, negotiated_version = Version} = State0,
Connection) ->
Connection:handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0);
@@ -623,7 +622,7 @@ cipher(#finished{verify_data = Data} = Finished,
cipher(#next_protocol{selected_protocol = SelectedProtocol},
#state{role = server, expecting_next_protocol_negotiation = true,
expecting_finished = true} = State0, Connection) ->
- {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}),
+ {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}),
Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false});
cipher(timeout, State, _) ->
@@ -759,10 +758,10 @@ handle_sync_event({get_opts, OptTags}, _From, StateName,
socket_options = SockOpts} = State) ->
OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []),
{reply, OptsReply, StateName, State, get_timeout(State)};
-handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) ->
- {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)};
-handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) ->
- {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)};
+handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = undefined} = State) ->
+ {reply, {error, protocol_not_negotiated}, StateName, State, get_timeout(State)};
+handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = SelectedProtocol} = State) ->
+ {reply, {ok, SelectedProtocol}, StateName, State, get_timeout(State)};
handle_sync_event({set_opts, Opts0}, _From, StateName0,
#state{socket_options = Opts1,
protocol_cb = Connection,
@@ -1484,11 +1483,11 @@ finalize_handshake(State0, StateName, Connection) ->
next_protocol(#state{role = server} = State, _) ->
State;
-next_protocol(#state{next_protocol = undefined} = State, _) ->
+next_protocol(#state{negotiated_protocol = undefined} = State, _) ->
State;
next_protocol(#state{expecting_next_protocol_negotiation = false} = State, _) ->
State;
-next_protocol(#state{next_protocol = NextProtocol} = State0, Connection) ->
+next_protocol(#state{negotiated_protocol = NextProtocol} = State0, Connection) ->
NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol),
Connection:send_handshake(NextProtocolMessage, State0).
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index ac3b26e4bf..e569d706af 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -78,7 +78,7 @@
allow_renegotiate = true ::boolean(),
expecting_next_protocol_negotiation = false ::boolean(),
expecting_finished = false ::boolean(),
- next_protocol = undefined :: undefined | binary(),
+ negotiated_protocol = undefined :: undefined | binary(),
client_ecc, % {Curves, PointFmt}
tracker :: pid() %% Tracker process for listen socket
}).
diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl
index b8761f0601..1a08d3c80a 100644
--- a/lib/ssl/src/ssl_crl.erl
+++ b/lib/ssl/src/ssl_crl.erl
@@ -73,8 +73,6 @@ verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) ->
true ->
throw({ok, ErlCertCandidate});
false ->
- NotIssuer;
- _ ->
NotIssuer
end;
_ ->
diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl
index b2bdb19979..b9d6a61c3b 100644
--- a/lib/ssl/src/ssl_crl_cache.erl
+++ b/lib/ssl/src/ssl_crl_cache.erl
@@ -34,7 +34,7 @@
%% Cache callback API
%%====================================================================
-lookup(#'DistributionPoint'{distributionPoint={fullName, Names}},
+lookup(#'DistributionPoint'{distributionPoint = {fullName, Names}},
CRLDbInfo) ->
get_crls(Names, CRLDbInfo);
lookup(_,_) ->
@@ -48,8 +48,8 @@ select(Issuer, {{_Cache, Mapping},_}) ->
CRLs
end.
-fresh_crl(DistributionPoint, CRL) ->
- case get_crls(DistributionPoint, undefined) of
+fresh_crl(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRL) ->
+ case get_crls(Names, undefined) of
not_available ->
CRL;
[NewCRL] ->
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 6cab8eb7a1..493e5a87d9 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -136,6 +136,7 @@ client_hello_extensions(Host, Version, CipherSuites, SslOpts, ConnectionStates,
hash_signs = advertised_hash_signs(Version),
ec_point_formats = EcPointFormats,
elliptic_curves = EllipticCurves,
+ alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation),
next_protocol_negotiation =
encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector,
Renegotiation),
@@ -764,6 +765,11 @@ encode_hello_extensions([], Acc) ->
Size = byte_size(Acc),
<<?UINT16(Size), Acc/binary>>;
+encode_hello_extensions([#alpn{extension_data = ExtensionData} | Rest], Acc) ->
+ Len = byte_size(ExtensionData),
+ ExtLen = Len + 2,
+ encode_hello_extensions(Rest, <<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len),
+ ExtensionData/binary, Acc/binary>>);
encode_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) ->
Len = byte_size(ExtensionData),
encode_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len),
@@ -862,6 +868,25 @@ decode_client_key(ClientKey, Type, Version) ->
decode_server_key(ServerKey, Type, Version) ->
dec_server_key(ServerKey, key_exchange_alg(Type), Version).
+%%
+%% Description: Encode and decode functions for ALPN extension data.
+%%--------------------------------------------------------------------
+
+%% While the RFC opens the door to allow ALPN during renegotiation, in practice
+%% this does not work and it is recommended to ignore any ALPN extension during
+%% renegotiation, as done here.
+encode_alpn(_, true) ->
+ undefined;
+encode_alpn(undefined, _) ->
+ undefined;
+encode_alpn(Protocols, _) ->
+ #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}.
+
+decode_alpn(undefined) ->
+ undefined;
+decode_alpn(#alpn{extension_data=Data}) ->
+ decode_protocols(Data, []).
+
encode_client_protocol_negotiation(undefined, _) ->
undefined;
encode_client_protocol_negotiation(_, false) ->
@@ -1124,8 +1149,10 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites,
#hello_extensions{renegotiation_info = Info,
srp = SRP,
ec_point_formats = ECCFormat,
+ alpn = ALPN,
next_protocol_negotiation = NextProtocolNegotiation}, Version,
- #ssl_options{secure_renegotiate = SecureRenegotation} = Opts,
+ #ssl_options{secure_renegotiate = SecureRenegotation,
+ alpn_preferred_protocols = ALPNPreferredProtocols} = Opts,
#session{cipher_suite = NegotiatedCipherSuite,
compression_method = Compression} = Session0,
ConnectionStates0, Renegotiation) ->
@@ -1134,19 +1161,34 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites,
Random, NegotiatedCipherSuite,
ClientCipherSuites, Compression,
ConnectionStates0, Renegotiation, SecureRenegotation),
- ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts),
-
+
ServerHelloExtensions = #hello_extensions{
renegotiation_info = renegotiation_info(RecordCB, server,
ConnectionStates, Renegotiation),
- ec_point_formats = server_ecc_extension(Version, ECCFormat),
- next_protocol_negotiation =
- encode_protocols_advertised_on_server(ProtocolsToAdvertise)
+ ec_point_formats = server_ecc_extension(Version, ECCFormat)
},
- {Session, ConnectionStates, ServerHelloExtensions}.
+
+ %% If we receive an ALPN extension and have ALPN configured for this connection,
+ %% we handle it. Otherwise we check for the NPN extension.
+ if
+ ALPN =/= undefined, ALPNPreferredProtocols =/= undefined ->
+ case handle_alpn_extension(ALPNPreferredProtocols, decode_alpn(ALPN)) of
+ #alert{} = Alert ->
+ Alert;
+ Protocol ->
+ {Session, ConnectionStates, Protocol,
+ ServerHelloExtensions#hello_extensions{alpn=encode_alpn([Protocol], Renegotiation)}}
+ end;
+ true ->
+ ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts),
+ {Session, ConnectionStates, undefined,
+ ServerHelloExtensions#hello_extensions{next_protocol_negotiation=
+ encode_protocols_advertised_on_server(ProtocolsToAdvertise)}}
+ end.
handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression,
#hello_extensions{renegotiation_info = Info,
+ alpn = ALPN,
next_protocol_negotiation = NextProtocolNegotiation}, Version,
#ssl_options{secure_renegotiate = SecureRenegotation,
next_protocol_selector = NextProtoSelector},
@@ -1155,11 +1197,23 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression,
CipherSuite, undefined,
Compression, ConnectionStates0,
Renegotiation, SecureRenegotation),
- case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of
- #alert{} = Alert ->
- Alert;
- Protocol ->
- {ConnectionStates, Protocol}
+
+ %% If we receive an ALPN extension then this is the protocol selected,
+ %% otherwise handle the NPN extension.
+ case decode_alpn(ALPN) of
+ %% ServerHello contains exactly one protocol: the one selected.
+ %% We also ignore the ALPN extension during renegotiation (see encode_alpn/2).
+ [Protocol] when not Renegotiation ->
+ {ConnectionStates, alpn, Protocol};
+ undefined ->
+ case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of
+ #alert{} = Alert ->
+ Alert;
+ Protocol ->
+ {ConnectionStates, npn, Protocol}
+ end;
+ _ -> %% {error, _Reason} or a list of 0/2+ protocols.
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)
end.
select_version(RecordCB, ClientVersion, Versions) ->
@@ -1267,10 +1321,11 @@ hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo,
hash_signs = HashSigns,
ec_point_formats = EcPointFormats,
elliptic_curves = EllipticCurves,
+ alpn = ALPN,
next_protocol_negotiation = NextProtocolNegotiation,
sni = Sni}) ->
[Ext || Ext <- [RenegotiationInfo, SRP, HashSigns,
- EcPointFormats, EllipticCurves, NextProtocolNegotiation, Sni], Ext =/= undefined].
+ EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined].
srp_user(#ssl_options{srp_identity = {UserName, _}}) ->
#srp{username = UserName};
@@ -1708,6 +1763,10 @@ dec_server_key_signature(_, _, _) ->
dec_hello_extensions(<<>>, Acc) ->
Acc;
+dec_hello_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc)
+ when Len + 2 =:= ExtLen ->
+ ALPN = #alpn{extension_data = ExtensionData},
+ dec_hello_extensions(Rest, Acc#hello_extensions{alpn = ALPN});
dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) ->
NextP = #next_protocol_negotiation{extension_data = ExtensionData},
dec_hello_extensions(Rest, Acc#hello_extensions{next_protocol_negotiation = NextP});
@@ -1788,18 +1847,19 @@ dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest);
dec_sni(_) -> undefined.
decode_next_protocols({next_protocol_negotiation, Protocols}) ->
- decode_next_protocols(Protocols, []).
-decode_next_protocols(<<>>, Acc) ->
+ decode_protocols(Protocols, []).
+
+decode_protocols(<<>>, Acc) ->
lists:reverse(Acc);
-decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) ->
+decode_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) ->
case Len of
0 ->
- {error, invalid_next_protocols};
+ {error, invalid_protocols};
_ ->
- decode_next_protocols(Rest, [Protocol|Acc])
+ decode_protocols(Rest, [Protocol|Acc])
end;
-decode_next_protocols(_Bytes, _Acc) ->
- {error, invalid_next_protocols}.
+decode_protocols(_Bytes, _Acc) ->
+ {error, invalid_protocols}.
%% encode/decode stream of certificate data to/from list of certificate data
certs_to_list(ASN1Certs) ->
@@ -1853,6 +1913,17 @@ key_exchange_alg(_) ->
%%-------------Extension handling --------------------------------
+%% Receive protocols, choose one from the list, return it.
+handle_alpn_extension(_, {error, _Reason}) ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE);
+handle_alpn_extension([], _) ->
+ ?ALERT_REC(?FATAL, ?NO_APPLICATION_PROTOCOL);
+handle_alpn_extension([ServerProtocol|Tail], ClientProtocols) ->
+ case lists:member(ServerProtocol, ClientProtocols) of
+ true -> ServerProtocol;
+ false -> handle_alpn_extension(Tail, ClientProtocols)
+ end.
+
handle_next_protocol(undefined,
_NextProtocolSelector, _Renegotiating) ->
undefined;
@@ -1998,12 +2069,12 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) -
case dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) of
[] ->
valid; %% No relevant CRL existed
- Dps ->
- crl_check_same_issuer(OtpCert, Check, Dps, Options)
+ DpsAndCRls ->
+ crl_check_same_issuer(OtpCert, Check, DpsAndCRls, Options)
end;
- Dps -> %% This DP list may be empty if relevant CRLs existed
+ DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed
%% but could not be retrived, will result in {bad_cert, revocation_status_undetermined}
- case public_key:pkix_crls_validate(OtpCert, Dps, Options) of
+ case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of
{bad_cert, revocation_status_undetermined} ->
crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback,
CRLDbHandle, same_issuer), Options);
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index 80284faef0..91f674a6fc 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -95,6 +95,7 @@
-record(hello_extensions, {
renegotiation_info,
hash_signs, % supported combinations of hashes/signature algos
+ alpn,
next_protocol_negotiation = undefined, % [binary()]
srp,
ec_point_formats,
@@ -301,6 +302,14 @@
}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Application-Layer Protocol Negotiation RFC 7301
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(ALPN_EXT, 16).
+
+-record(alpn, {extension_data}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Next Protocol Negotiation
%% (http://tools.ietf.org/html/draft-agl-tls-nextprotoneg-02)
%% (http://technotes.googlecode.com/git/nextprotoneg.html)
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 8df79f9e8c..e09a72a3f3 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -116,6 +116,8 @@
hibernate_after :: boolean(),
%% This option should only be set to true by inet_tls_dist
erl_dist = false :: boolean(),
+ alpn_advertised_protocols = undefined :: [binary()],
+ alpn_preferred_protocols = undefined :: [binary()],
next_protocols_advertised = undefined, %% [binary()],
next_protocol_selector = undefined, %% fun([binary()]) -> binary())
log_alert :: boolean(),
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 9c4b2a8bad..396013825e 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -101,8 +101,10 @@ start_link_dist(Opts) ->
gen_server:start_link({local, DistMangerName}, ?MODULE, [DistMangerName, Opts], []).
%%--------------------------------------------------------------------
--spec connection_init(binary()| {der, list()}, client | server, {Cb :: atom(), Handle:: term()}) ->
- {ok, certdb_ref(), db_handle(), db_handle(), db_handle(), db_handle()}.
+-spec connection_init(binary()| {der, list()}, client | server,
+ {Cb :: atom(), Handle:: term()}) ->
+ {ok, certdb_ref(), db_handle(), db_handle(),
+ db_handle(), db_handle(), CRLInfo::term()}.
%%
%% Description: Do necessary initializations for a new connection.
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 77d3aa7889..0577222980 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -188,19 +188,27 @@ hello(Hello = #client_hello{client_version = ClientVersion,
renegotiation = {Renegotiation, _},
session_cache = Cache,
session_cache_cb = CacheCb,
+ negotiated_protocol = CurrentProtocol,
ssl_options = SslOpts}) ->
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
+ #alert{} = Alert ->
+ handle_own_alert(Alert, ClientVersion, hello, State);
{Version, {Type, Session},
- ConnectionStates, ServerHelloExt} ->
+ ConnectionStates, Protocol0, ServerHelloExt} ->
+
+ Protocol = case Protocol0 of
+ undefined -> CurrentProtocol;
+ _ -> Protocol0
+ end,
+
HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version),
ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
session = Session,
- client_ecc = {EllipticCurves, EcPointFormats}}, ?MODULE);
- #alert{} = Alert ->
- handle_own_alert(Alert, ClientVersion, hello, State)
+ client_ecc = {EllipticCurves, EcPointFormats},
+ negotiated_protocol = Protocol}, ?MODULE)
end;
hello(Hello,
#state{connection_states = ConnectionStates0,
@@ -211,9 +219,9 @@ hello(Hello,
case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
handle_own_alert(Alert, ReqVersion, hello, State);
- {Version, NewId, ConnectionStates, NextProtocol} ->
+ {Version, NewId, ConnectionStates, ProtoExt, Protocol} ->
ssl_connection:handle_session(Hello,
- Version, NewId, ConnectionStates, NextProtocol, State)
+ Version, NewId, ConnectionStates, ProtoExt, Protocol, State)
end;
hello(Msg, State) ->
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index b0b6d5a8e3..2d50dd7e46 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -82,8 +82,7 @@ client_hello(Host, Port, ConnectionStates,
boolean()) ->
{tls_record:tls_version(), session_id(), #connection_states{}, binary() | undefined}|
{tls_record:tls_version(), {resumed | new, #session{}}, #connection_states{},
- [binary()] | undefined,
- [ssl_handshake:oid()] | undefined, [ssl_handshake:oid()] | undefined} |
+ #hello_extensions{}} |
#alert{}.
%%
%% Description: Handles a recieved hello message
@@ -246,8 +245,10 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites,
try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites,
HelloExt, Version, SslOpts,
Session0, ConnectionStates0, Renegotiation) of
- {Session, ConnectionStates, ServerHelloExt} ->
- {Version, {Type, Session}, ConnectionStates, ServerHelloExt}
+ #alert{} = Alert ->
+ Alert;
+ {Session, ConnectionStates, Protocol, ServerHelloExt} ->
+ {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt}
catch throw:Alert ->
Alert
end.
@@ -260,7 +261,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
SslOpt, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
Alert;
- {ConnectionStates, Protocol} ->
- {Version, SessionId, ConnectionStates, Protocol}
+ {ConnectionStates, ProtoExt, Protocol} ->
+ {Version, SessionId, ConnectionStates, ProtoExt, Protocol}
end.
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 09cc5981e7..8c45a788a4 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -36,6 +36,7 @@ VSN=$(GS_VSN)
MODULES = \
ssl_test_lib \
+ ssl_alpn_handshake_SUITE \
ssl_basic_SUITE \
ssl_bench_SUITE \
ssl_cipher_SUITE \
diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl
new file mode 100644
index 0000000000..ccd70fa605
--- /dev/null
+++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl
@@ -0,0 +1,414 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2015. 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_alpn_handshake_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+-include_lib("common_test/include/ct.hrl").
+
+-define(SLEEP, 500).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'},
+ {group, 'sslv3'}].
+
+groups() ->
+ [
+ {'tlsv1.2', [], alpn_tests()},
+ {'tlsv1.1', [], alpn_tests()},
+ {'tlsv1', [], alpn_tests()},
+ {'sslv3', [], alpn_not_supported()}
+ ].
+
+alpn_tests() ->
+ [empty_protocols_are_not_allowed,
+ protocols_must_be_a_binary_list,
+ empty_client,
+ empty_server,
+ empty_client_empty_server,
+ no_matching_protocol,
+ client_alpn_and_server_alpn,
+ client_alpn_and_server_no_support,
+ client_no_support_and_server_alpn,
+ client_alpn_npn_and_server_alpn,
+ client_alpn_npn_and_server_alpn_npn,
+ client_alpn_and_server_alpn_npn,
+ client_renegotiate,
+ session_reused
+ ].
+
+alpn_not_supported() ->
+ [alpn_not_supported_client,
+ alpn_not_supported_server
+ ].
+
+init_per_suite(Config) ->
+ catch crypto:stop(),
+ try crypto:start() of
+ ok ->
+ ssl:start(),
+ Result =
+ (catch make_certs:all(?config(data_dir, Config),
+ ?config(priv_dir, Config))),
+ ct:log("Make certs ~p~n", [Result]),
+ ssl_test_lib:cert_options(Config)
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(_Config) ->
+ ssl:stop(),
+ application:unload(ssl),
+ application:stop(crypto).
+
+
+init_per_group(GroupName, Config) ->
+ case ssl_test_lib:is_tls_version(GroupName) of
+ true ->
+ case ssl_test_lib:sufficient_crypto_support(GroupName) of
+ true ->
+ ssl_test_lib:init_tls_version(GroupName),
+ Config;
+ false ->
+ {skip, "Missing crypto support"}
+ end;
+ _ ->
+ ssl:start(),
+ Config
+ end.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+empty_protocols_are_not_allowed(Config) when is_list(Config) ->
+ {error, {options, {alpn_preferred_protocols, {invalid_protocol, <<>>}}}}
+ = (catch ssl:listen(9443,
+ [{alpn_preferred_protocols, [<<"foo/1">>, <<"">>]}])),
+ {error, {options, {alpn_advertised_protocols, {invalid_protocol, <<>>}}}}
+ = (catch ssl:connect({127,0,0,1}, 9443,
+ [{alpn_advertised_protocols, [<<"foo/1">>, <<"">>]}])).
+
+%--------------------------------------------------------------------------------
+
+protocols_must_be_a_binary_list(Config) when is_list(Config) ->
+ Option1 = {alpn_preferred_protocols, hello},
+ {error, {options, Option1}} = (catch ssl:listen(9443, [Option1])),
+ Option2 = {alpn_preferred_protocols, [<<"foo/1">>, hello]},
+ {error, {options, {alpn_preferred_protocols, {invalid_protocol, hello}}}}
+ = (catch ssl:listen(9443, [Option2])),
+ Option3 = {alpn_advertised_protocols, hello},
+ {error, {options, Option3}} = (catch ssl:connect({127,0,0,1}, 9443, [Option3])),
+ Option4 = {alpn_advertised_protocols, [<<"foo/1">>, hello]},
+ {error, {options, {alpn_advertised_protocols, {invalid_protocol, hello}}}}
+ = (catch ssl:connect({127,0,0,1}, 9443, [Option4])).
+
+%--------------------------------------------------------------------------------
+
+empty_client(Config) when is_list(Config) ->
+ run_failing_handshake(Config,
+ [{alpn_advertised_protocols, []}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
+ {connect_failed,{tls_alert,"no application protocol"}}).
+
+%--------------------------------------------------------------------------------
+
+empty_server(Config) when is_list(Config) ->
+ run_failing_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, []}],
+ {connect_failed,{tls_alert,"no application protocol"}}).
+
+%--------------------------------------------------------------------------------
+
+empty_client_empty_server(Config) when is_list(Config) ->
+ run_failing_handshake(Config,
+ [{alpn_advertised_protocols, []}],
+ [{alpn_preferred_protocols, []}],
+ {connect_failed,{tls_alert,"no application protocol"}}).
+
+%--------------------------------------------------------------------------------
+
+no_matching_protocol(Config) when is_list(Config) ->
+ run_failing_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
+ {connect_failed,{tls_alert,"no application protocol"}}).
+
+%--------------------------------------------------------------------------------
+
+client_alpn_and_server_alpn(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+
+%--------------------------------------------------------------------------------
+
+client_alpn_and_server_no_support(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [],
+ {error, protocol_not_negotiated}).
+
+%--------------------------------------------------------------------------------
+
+client_no_support_and_server_alpn(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {error, protocol_not_negotiated}).
+
+%--------------------------------------------------------------------------------
+
+client_alpn_npn_and_server_alpn(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]},
+ {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+
+%--------------------------------------------------------------------------------
+
+client_alpn_npn_and_server_alpn_npn(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]},
+ {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]},
+ {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+
+%--------------------------------------------------------------------------------
+
+client_alpn_and_server_alpn_npn(Config) when is_list(Config) ->
+ run_handshake(Config,
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]},
+ {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+
+%--------------------------------------------------------------------------------
+
+client_renegotiate(Config) when is_list(Config) ->
+ Data = "hello world",
+
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0,
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0,
+ ExpectedProtocol = {ok, <<"http/1.0">>},
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, assert_alpn_and_renegotiate_and_send_data, [ExpectedProtocol, Data]}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+%--------------------------------------------------------------------------------
+
+session_reused(Config) when is_list(Config)->
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0,
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0,
+
+ {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, session_info_result, []}},
+ {options, 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, no_result_msg, []}},
+ {options, ClientOpts}]),
+
+ SessionInfo =
+ receive
+ {Server, Info} ->
+ Info
+ end,
+
+ Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}},
+
+ %% Make sure session is registered
+ ct:sleep(?SLEEP),
+
+ Client1 =
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, session_info_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
+ receive
+ {Client1, SessionInfo} ->
+ ok;
+ {Client1, Other} ->
+ ct:fail(Other)
+ end,
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client),
+ ssl_test_lib:close(Client1).
+
+%--------------------------------------------------------------------------------
+
+alpn_not_supported_client(Config) when is_list(Config) ->
+ ClientOpts0 = ?config(client_opts, Config),
+ PrefProtocols = {client_preferred_next_protocols,
+ {client, [<<"http/1.0">>], <<"http/1.1">>}},
+ ClientOpts = [PrefProtocols] ++ ClientOpts0,
+ {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Client = ssl_test_lib:start_client_error([{node, ClientNode},
+ {port, 8888}, {host, Hostname},
+ {from, self()}, {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Client, {error,
+ {options,
+ {not_supported_in_sslv3, PrefProtocols}}}).
+
+%--------------------------------------------------------------------------------
+
+alpn_not_supported_server(Config) when is_list(Config)->
+ ServerOpts0 = ?config(server_opts, Config),
+ AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]},
+ ServerOpts = [AdvProtocols] ++ ServerOpts0,
+
+ {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts).
+
+%%--------------------------------------------------------------------
+%% Internal functions ------------------------------------------------
+%%--------------------------------------------------------------------
+
+run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) ->
+ ClientOpts = ClientExtraOpts ++ ?config(client_opts, Config),
+ ServerOpts = ServerExtraOpts ++ ?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, {?MODULE, placeholder, []}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ ExpectedResult
+ = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, placeholder, []}},
+ {options, ClientOpts}]).
+
+run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) ->
+ Data = "hello world",
+
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = ClientExtraOpts ++ ClientOpts0,
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = ServerExtraOpts ++ ServerOpts0,
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, ssl_send_and_assert_alpn, [ExpectedProtocol, Data]}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+assert_alpn(Socket, Protocol) ->
+ ct:log("Negotiated Protocol ~p, Expecting: ~p ~n",
+ [ssl:negotiated_protocol(Socket), Protocol]),
+ Protocol = ssl:negotiated_protocol(Socket).
+
+assert_alpn_and_renegotiate_and_send_data(Socket, Protocol, Data) ->
+ assert_alpn(Socket, Protocol),
+ ct:log("Renegotiating ~n", []),
+ ok = ssl:renegotiate(Socket),
+ ssl:send(Socket, Data),
+ assert_alpn(Socket, Protocol),
+ ok.
+
+ssl_send_and_assert_alpn(Socket, Protocol, Data) ->
+ assert_alpn(Socket, Protocol),
+ ssl_send(Socket, Data).
+
+ssl_receive_and_assert_alpn(Socket, Protocol, Data) ->
+ assert_alpn(Socket, Protocol),
+ ssl_receive(Socket, Data).
+
+ssl_send(Socket, Data) ->
+ ct:log("Connection info: ~p~n",
+ [ssl:connection_info(Socket)]),
+ ssl:send(Socket, Data).
+
+ssl_receive(Socket, Data) ->
+ ssl_receive(Socket, Data, []).
+
+ssl_receive(Socket, Data, Buffer) ->
+ ct:log("Connection info: ~p~n",
+ [ssl:connection_info(Socket)]),
+ receive
+ {ssl, Socket, MoreData} ->
+ ct:log("Received ~p~n",[MoreData]),
+ NewBuffer = Buffer ++ MoreData,
+ case NewBuffer of
+ Data ->
+ ssl:send(Socket, "Got it"),
+ ok;
+ _ ->
+ ssl_receive(Socket, Data, NewBuffer)
+ end;
+ Other ->
+ ct:fail({unexpected_message, Other})
+ after 4000 ->
+ ct:fail({did_not_get, Data})
+ end.
+
+connection_info_result(Socket) ->
+ ssl:connection_info(Socket).
diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl
index 30c0a67a36..326f907e66 100644
--- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl
@@ -172,7 +172,7 @@ no_client_negotiate_but_server_supports_npn(Config) when is_list(Config) ->
run_npn_handshake(Config,
[],
[{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}],
- {error, next_protocol_not_negotiated}).
+ {error, protocol_not_negotiated}).
%--------------------------------------------------------------------------------
@@ -180,7 +180,7 @@ client_negotiate_server_does_not_support(Config) when is_list(Config) ->
run_npn_handshake(Config,
[{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}],
[],
- {error, next_protocol_not_negotiated}).
+ {error, protocol_not_negotiated}).
%--------------------------------------------------------------------------------
renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) ->
@@ -311,8 +311,8 @@ run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) ->
assert_npn(Socket, Protocol) ->
ct:log("Negotiated Protocol ~p, Expecting: ~p ~n",
- [ssl:negotiated_next_protocol(Socket), Protocol]),
- Protocol = ssl:negotiated_next_protocol(Socket).
+ [ssl:negotiated_protocol(Socket), Protocol]),
+ Protocol = ssl:negotiated_protocol(Socket).
assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) ->
assert_npn(Socket, Protocol),
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 7d0546210c..d19e3b7fdb 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -1090,6 +1090,8 @@ cipher_restriction(Config0) ->
check_sane_openssl_version(Version) ->
case {Version, os:cmd("openssl version")} of
+ {_, "OpenSSL 1.0.2" ++ _} ->
+ true;
{_, "OpenSSL 1.0.1" ++ _} ->
true;
{'tlsv1.2', "OpenSSL 1.0" ++ _} ->
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 942c446ec4..94426a3061 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -50,9 +50,9 @@ all() ->
groups() ->
[{basic, [], basic_tests()},
- {'tlsv1.2', [], all_versions_tests() ++ npn_tests()},
- {'tlsv1.1', [], all_versions_tests() ++ npn_tests()},
- {'tlsv1', [], all_versions_tests()++ npn_tests()},
+ {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()},
+ {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()},
+ {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests()},
{'sslv3', [], all_versions_tests()}].
basic_tests() ->
@@ -79,6 +79,18 @@ all_versions_tests() ->
expired_session,
ssl2_erlang_server_openssl_client].
+alpn_tests() ->
+ [erlang_client_alpn_openssl_server_alpn,
+ erlang_server_alpn_openssl_client_alpn,
+ erlang_client_alpn_openssl_server,
+ erlang_client_openssl_server_alpn,
+ erlang_server_alpn_openssl_client,
+ erlang_server_openssl_client_alpn,
+ erlang_client_alpn_openssl_server_alpn_renegotiate,
+ erlang_server_alpn_openssl_client_alpn_renegotiate,
+ erlang_client_alpn_npn_openssl_server_alpn_npn,
+ erlang_server_alpn_npn_openssl_client_alpn_npn].
+
npn_tests() ->
[erlang_client_openssl_server_npn,
erlang_server_openssl_client_npn,
@@ -161,6 +173,36 @@ special_init(ssl2_erlang_server_openssl_client, Config) ->
check_sane_openssl_sslv2(Config);
special_init(TestCase, Config)
+ when TestCase == erlang_client_alpn_openssl_server_alpn;
+ TestCase == erlang_server_alpn_openssl_client_alpn;
+ TestCase == erlang_client_alpn_openssl_server;
+ TestCase == erlang_client_openssl_server_alpn;
+ TestCase == erlang_server_alpn_openssl_client;
+ TestCase == erlang_server_openssl_client_alpn ->
+ check_openssl_alpn_support(Config);
+
+special_init(TestCase, Config)
+ when TestCase == erlang_client_alpn_openssl_server_alpn_renegotiate;
+ TestCase == erlang_server_alpn_openssl_client_alpn_renegotiate ->
+ {ok, Version} = application:get_env(ssl, protocol_version),
+ case check_sane_openssl_renegotaite(Config, Version) of
+ {skip, _} = Skip ->
+ Skip;
+ _ ->
+ check_openssl_alpn_support(Config)
+ end;
+
+special_init(TestCase, Config)
+ when TestCase == erlang_client_alpn_npn_openssl_server_alpn_npn;
+ TestCase == erlang_server_alpn_npn_openssl_client_alpn_npn ->
+ case check_openssl_alpn_support(Config) of
+ {skip, _} = Skip ->
+ Skip;
+ _ ->
+ check_openssl_npn_support(Config)
+ end;
+
+special_init(TestCase, Config)
when TestCase == erlang_client_openssl_server_npn;
TestCase == erlang_server_openssl_client_npn;
TestCase == erlang_server_openssl_client_npn_only_server;
@@ -179,6 +221,7 @@ special_init(TestCase, Config)
_ ->
check_openssl_npn_support(Config)
end;
+
special_init(_, Config) ->
Config.
@@ -924,6 +967,128 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
+
+erlang_client_alpn_openssl_server_alpn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
+
+erlang_server_alpn_openssl_client_alpn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_client_alpn_openssl_server(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_with_opts(Config,
+ [{alpn_advertised_protocols, [<<"spdy/2">>]}],
+ "",
+ Data, fun(Server, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_client_openssl_server_alpn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_with_opts(Config,
+ [],
+ "-alpn spdy/2",
+ Data, fun(Server, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_server_alpn_openssl_client(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_with_opts(Config,
+ [{alpn_advertised_protocols, [<<"spdy/2">>]}],
+ "",
+ Data, fun(Server, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_server_openssl_client_alpn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_with_opts(Config,
+ [],
+ "-alpn spdy/2",
+ Data, fun(Server, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
+
+erlang_client_alpn_openssl_server_alpn_renegotiate(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE),
+ ct:sleep(?SLEEP),
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
+
+erlang_server_alpn_openssl_client_alpn_renegotiate(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE),
+ ct:sleep(?SLEEP),
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
+
+erlang_client_alpn_npn_openssl_server_alpn_npn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
+
+erlang_server_alpn_npn_openssl_client_alpn_npn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ true = port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------
erlang_client_openssl_server_npn() ->
[{doc,"Test erlang client with openssl server doing npn negotiation"}].
@@ -1139,6 +1304,142 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
ssl_test_lib:close(Client),
process_flag(trap_exit, false).
+start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0],
+
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
+ Data = "From openssl to erlang",
+
+ Port = ssl_test_lib:inet_port(node()),
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ KeyFile = proplists:get_value(keyfile, ServerOpts),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+
+ Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile,
+
+ ct:log("openssl cmd: ~p~n", [Cmd]),
+
+ OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ ssl_test_lib:wait_for_openssl_server(),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
+ {options, ClientOpts}]),
+
+ Callback(Client, OpensslPort),
+
+ %% Clean close down! Server needs to be closed first !!
+ ssl_test_lib:close_port(OpensslPort),
+
+ ssl_test_lib:close(Client),
+ process_flag(trap_exit, false).
+
+start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0],
+
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+ Cmd = "openssl s_client -alpn http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++
+ " -host localhost",
+
+ ct:log("openssl cmd: ~p~n", [Cmd]),
+
+ OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ Callback(Server, OpenSslPort),
+
+ ssl_test_lib:close(Server),
+
+ ssl_test_lib:close_port(OpenSslPort),
+ process_flag(trap_exit, false).
+
+start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]},
+ {client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0],
+
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
+ Data = "From openssl to erlang",
+
+ Port = ssl_test_lib:inet_port(node()),
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ KeyFile = proplists:get_value(keyfile, ServerOpts),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+
+ Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile,
+
+ ct:log("openssl cmd: ~p~n", [Cmd]),
+
+ OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ ssl_test_lib:wait_for_openssl_server(),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
+ {options, ClientOpts}]),
+
+ Callback(Client, OpensslPort),
+
+ %% Clean close down! Server needs to be closed first !!
+ ssl_test_lib:close_port(OpensslPort),
+
+ ssl_test_lib:close(Client),
+ process_flag(trap_exit, false).
+
+start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]},
+ {next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0],
+
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+ Cmd = "openssl s_client -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++
+ " -host localhost",
+
+ ct:log("openssl cmd: ~p~n", [Cmd]),
+
+ OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ Callback(Server, OpenSslPort),
+
+ ssl_test_lib:close(Server),
+
+ ssl_test_lib:close_port(OpenSslPort),
+ process_flag(trap_exit, false).
+
start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
ServerOpts = ?config(server_opts, Config),
@@ -1167,7 +1468,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
{host, Hostname},
{from, self()},
{mfa, {?MODULE,
- erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}},
+ erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
{options, ClientOpts}]),
Callback(Client, OpensslPort),
@@ -1188,7 +1489,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
- {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}},
+ {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
@@ -1236,10 +1537,10 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS
process_flag(trap_exit, false).
-erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) ->
- {ok, Protocol} = ssl:negotiated_next_protocol(Socket),
+erlang_ssl_receive_and_assert_negotiated_protocol(Socket, Protocol, Data) ->
+ {ok, Protocol} = ssl:negotiated_protocol(Socket),
erlang_ssl_receive(Socket, Data),
- {ok, Protocol} = ssl:negotiated_next_protocol(Socket),
+ {ok, Protocol} = ssl:negotiated_protocol(Socket),
ok.
erlang_ssl_receive(Socket, Data) ->
@@ -1297,6 +1598,15 @@ check_openssl_npn_support(Config) ->
Config
end.
+check_openssl_alpn_support(Config) ->
+ HelpText = os:cmd("openssl s_client --help"),
+ case string:str(HelpText, "alpn") of
+ 0 ->
+ {skip, "Openssl not compiled with alpn support"};
+ _ ->
+ Config
+ end.
+
check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1';
Version == 'tlsv1.2' ->
case os:cmd("openssl version") of
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 902a921fbf..6b9524ef63 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -1618,14 +1618,18 @@ true</pre>
</func>
<func>
<name name="update_counter" arity="3" clause_i="1"/>
+ <name name="update_counter" arity="4" clause_i="1"/>
<name name="update_counter" arity="3" clause_i="2"/>
+ <name name="update_counter" arity="4" clause_i="2"/>
<name name="update_counter" arity="3" clause_i="3"/>
+ <name name="update_counter" arity="4" clause_i="3"/>
<type variable="Tab"/>
<type variable="Key"/>
<type variable="UpdateOp" name_i="1"/>
<type variable="Pos" name_i="1"/>
<type variable="Threshold" name_i="1"/>
<type variable="SetValue" name_i="1"/>
+ <type variable="Default"/>
<fsummary>Update a counter object in an ETS table.</fsummary>
<desc>
<p>This function provides an efficient way to update one or more
@@ -1667,12 +1671,22 @@ true</pre>
<seealso marker="#lookup/2">lookup/2</seealso> and
<seealso marker="#new/2">new/2</seealso>
for details on the difference).</p>
+ <p>If a default object <c><anno>Default</anno></c> is given, it is used
+ as the object to be updated if the key is missing from the table. The
+ value in place of the key is ignored and replaced by the proper key
+ value. The return value is as if the default object had not been used,
+ that is a single updated element or a list of them.</p>
<p>The function will fail with reason <c>badarg</c> if:</p>
<list type="bulleted">
<item>the table is not of type <c>set</c> or
<c>ordered_set</c>,</item>
- <item>no object with the right key exists,</item>
+ <item>no object with the right key exists and no default object were
+ supplied,</item>
<item>the object has the wrong arity,</item>
+ <item>the default object arity is smaller than
+ <c><![CDATA[<keypos>]]></c></item>
+ <item>any field from the default object being updated is not an
+ integer</item>
<item>the element to update is not an integer,</item>
<item>the element to update is also the key, or,</item>
<item>any of <c><anno>Pos</anno></c>, <c><anno>Incr</anno></c>, <c><anno>Threshold</anno></c> or
diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml
index f27a974242..9a0ff85038 100644
--- a/lib/stdlib/doc/src/proc_lib.xml
+++ b/lib/stdlib/doc/src/proc_lib.xml
@@ -173,7 +173,7 @@
<name name="init_ack" arity="2"/>
<fsummary>Used by a process when it has started.</fsummary>
<desc>
- <p>This function must used by a process that has been started by
+ <p>This function must be used by a process that has been started by
a <seealso marker="#start/3">start[_link]/3,4,5</seealso>
function. It tells <c><anno>Parent</anno></c> that the process has
initialized itself, has started, or has failed to initialize
diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml
index 48b376743d..d201e81a79 100644
--- a/lib/stdlib/doc/src/zip.xml
+++ b/lib/stdlib/doc/src/zip.xml
@@ -135,6 +135,12 @@
<p>These options are described in <seealso marker="#zip_options">create/3</seealso>.</p>
</desc>
</datatype>
+ <datatype>
+ <name name="handle"/>
+ <desc>
+ <p>As returned by <seealso marker="#zip_open/2">zip_open/2</seealso>.</p>
+ </desc>
+ </datatype>
</datatypes>
<funcs>
<func>
@@ -430,6 +436,8 @@
means that subsequently reading files from the archive will be
faster than unzipping files one at a time with <c>unzip</c>.</p>
<p>The archive must be closed with <c>zip_close/1</c>.</p>
+ <p>The <c><anno>ZipHandle</anno></c> will be closed if the
+ process which originally opened the archive dies.</p>
</desc>
</func>
<func>
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 09c8924650..1df069755d 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -72,7 +72,7 @@
select_count/2, select_delete/2, select_reverse/1,
select_reverse/2, select_reverse/3, setopts/2, slot/2,
take/2,
- update_counter/3, update_element/3]).
+ update_counter/3, update_counter/4, update_element/3]).
-spec all() -> [Tab] when
Tab :: tab().
@@ -439,6 +439,38 @@ take(_, _) ->
update_counter(_, _, _) ->
erlang:nif_error(undef).
+-spec update_counter(Tab, Key, UpdateOp, Default) -> Result when
+ Tab :: tab(),
+ Key :: term(),
+ UpdateOp :: {Pos, Incr}
+ | {Pos, Incr, Threshold, SetValue},
+ Pos :: integer(),
+ Incr :: integer(),
+ Threshold :: integer(),
+ SetValue :: integer(),
+ Result :: integer(),
+ Default :: tuple();
+ (Tab, Key, [UpdateOp], Default) -> [Result] when
+ Tab :: tab(),
+ Key :: term(),
+ UpdateOp :: {Pos, Incr}
+ | {Pos, Incr, Threshold, SetValue},
+ Pos :: integer(),
+ Incr :: integer(),
+ Threshold :: integer(),
+ SetValue :: integer(),
+ Result :: integer(),
+ Default :: tuple();
+ (Tab, Key, Incr, Default) -> Result when
+ Tab :: tab(),
+ Key :: term(),
+ Incr :: integer(),
+ Result :: integer(),
+ Default :: tuple().
+
+update_counter(_, _, _, _) ->
+ erlang:nif_error(undef).
+
-spec update_element(Tab, Key, ElementSpec :: {Pos, Value}) -> boolean() when
Tab :: tab(),
Key :: term(),
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index e90cda0533..3378d668a5 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -287,6 +287,8 @@ write([H|T], D) ->
end;
write(F, _D) when is_function(F) ->
erlang:fun_to_list(F);
+write(Term, D) when is_map(Term) ->
+ write_map(Term, D);
write(T, D) when is_tuple(T) ->
if
D =:= 1 -> "{...}";
@@ -295,9 +297,7 @@ write(T, D) when is_tuple(T) ->
[write(element(1, T), D-1)|
write_tail(tl(tuple_to_list(T)), D-1, $,)],
$}]
- end;
-%write(Term, D) when is_map(Term) -> write_map(Term, D);
-write(Term, D) -> write_map(Term, D).
+ end.
%% write_tail(List, Depth, CharacterBeforeDots)
%% Test the terminating case first as this looks better with depth.
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 4a338798d0..d6afa5e09b 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -590,6 +590,8 @@ obsolete_1(core_lib, is_literal_list, 1) ->
" instead"};
obsolete_1(core_lib, literal_value, 1) ->
{deprecated,{core_lib,concrete,1}};
+obsolete_1(ssl, negotiated_next_protocol, 1) ->
+ {deprecated,{ssl,negotiated_protocol}};
obsolete_1(_, _, _) ->
no.
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index b768c6d0b9..44e75ff15b 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -214,7 +214,9 @@
-type zip_comment() :: #zip_comment{}.
-type zip_file() :: #zip_file{}.
--export_type([create_option/0, filename/0]).
+-opaque handle() :: pid().
+
+-export_type([create_option/0, filename/0, handle/0]).
%% Open a zip archive with options
%%
@@ -500,7 +502,7 @@ do_list_dir(F, Options) ->
-spec(t(Archive) -> ok when
Archive :: file:name() | binary() | ZipHandle,
- ZipHandle :: pid()).
+ ZipHandle :: handle()).
t(F) when is_pid(F) -> zip_t(F);
t(F) when is_record(F, openzip) -> openzip_t(F);
@@ -524,7 +526,7 @@ do_t(F, RawPrint) ->
-spec(tt(Archive) -> ok when
Archive :: file:name() | binary() | ZipHandle,
- ZipHandle :: pid()).
+ ZipHandle :: handle()).
tt(F) when is_pid(F) -> zip_tt(F);
tt(F) when is_record(F, openzip) -> openzip_tt(F);
@@ -1114,15 +1116,19 @@ local_file_header_from_info_method_name(#file_info{mtime = MTime},
file_name_length = length(Name),
extra_field_length = 0}.
+server_init(Parent) ->
+ %% we want to know if our parent dies
+ process_flag(trap_exit, true),
+ server_loop(Parent, not_open).
%% small, simple, stupid zip-archive server
-server_loop(OpenZip) ->
+server_loop(Parent, OpenZip) ->
receive
{From, {open, Archive, Options}} ->
case openzip_open(Archive, Options) of
{ok, NewOpenZip} ->
From ! {self(), {ok, self()}},
- server_loop(NewOpenZip);
+ server_loop(Parent, NewOpenZip);
Error ->
From ! {self(), Error}
end;
@@ -1130,43 +1136,47 @@ server_loop(OpenZip) ->
From ! {self(), openzip_close(OpenZip)};
{From, get} ->
From ! {self(), openzip_get(OpenZip)},
- server_loop(OpenZip);
+ server_loop(Parent, OpenZip);
{From, {get, FileName}} ->
From ! {self(), openzip_get(FileName, OpenZip)},
- server_loop(OpenZip);
+ server_loop(Parent, OpenZip);
{From, list_dir} ->
From ! {self(), openzip_list_dir(OpenZip)},
- server_loop(OpenZip);
+ server_loop(Parent, OpenZip);
{From, {list_dir, Opts}} ->
From ! {self(), openzip_list_dir(OpenZip, Opts)},
- server_loop(OpenZip);
+ server_loop(Parent, OpenZip);
{From, get_state} ->
From ! {self(), OpenZip},
- server_loop(OpenZip);
+ server_loop(Parent, OpenZip);
+ {'EXIT', Parent, Reason} ->
+ openzip_close(OpenZip),
+ exit({parent_died, Reason});
_ ->
{error, bad_msg}
end.
-spec(zip_open(Archive) -> {ok, ZipHandle} | {error, Reason} when
Archive :: file:name() | binary(),
- ZipHandle :: pid(),
+ ZipHandle :: handle(),
Reason :: term()).
zip_open(Archive) -> zip_open(Archive, []).
-spec(zip_open(Archive, Options) -> {ok, ZipHandle} | {error, Reason} when
Archive :: file:name() | binary(),
- ZipHandle :: pid(),
+ ZipHandle :: handle(),
Options :: [Option],
Option :: cooked | memory | {cwd, CWD :: file:filename()},
Reason :: term()).
zip_open(Archive, Options) ->
- Pid = spawn(fun() -> server_loop(not_open) end),
- request(self(), Pid, {open, Archive, Options}).
+ Self = self(),
+ Pid = spawn_link(fun() -> server_init(Self) end),
+ request(Self, Pid, {open, Archive, Options}).
-spec(zip_get(ZipHandle) -> {ok, [Result]} | {error, Reason} when
- ZipHandle :: pid(),
+ ZipHandle :: handle(),
Result :: file:name() | {file:name(), binary()},
Reason :: term()).
@@ -1174,14 +1184,14 @@ zip_get(Pid) when is_pid(Pid) ->
request(self(), Pid, get).
-spec(zip_close(ZipHandle) -> ok | {error, einval} when
- ZipHandle :: pid()).
+ ZipHandle :: handle()).
zip_close(Pid) when is_pid(Pid) ->
request(self(), Pid, close).
-spec(zip_get(FileName, ZipHandle) -> {ok, Result} | {error, Reason} when
FileName :: file:name(),
- ZipHandle :: pid(),
+ ZipHandle :: handle(),
Result :: file:name() | {file:name(), binary()},
Reason :: term()).
@@ -1190,7 +1200,7 @@ zip_get(FileName, Pid) when is_pid(Pid) ->
-spec(zip_list_dir(ZipHandle) -> {ok, Result} | {error, Reason} when
Result :: [zip_comment() | zip_file()],
- ZipHandle :: pid(),
+ ZipHandle :: handle(),
Reason :: term()).
zip_list_dir(Pid) when is_pid(Pid) ->
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 2674f6886f..9f552b5a6b 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -47,6 +47,7 @@
-export([ordered/1, ordered_match/1, interface_equality/1,
fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1,
update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]).
+-export([update_counter_with_default/1]).
-export([member/1]).
-export([memory/1]).
-export([select_fail/1]).
@@ -99,7 +100,7 @@
misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1,
heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1,
do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2,
- types_do/1, sleeper/0, memory_do/1,
+ types_do/1, sleeper/0, memory_do/1, update_counter_with_default_do/1,
ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4
]).
@@ -136,7 +137,8 @@ all() ->
{group, heavy}, ordered, ordered_match,
interface_equality, fixtable_next, fixtable_insert,
rename, rename_unnamed, evil_rename, update_element,
- update_counter, evil_update_counter, partly_bound,
+ update_counter, evil_update_counter,
+ update_counter_with_default, partly_bound,
match_heavy, {group, fold}, member, t_delete_object,
t_init_table, t_whitebox, t_delete_all_objects,
t_insert_list, t_test_ms, t_select_delete, t_ets_dets,
@@ -1761,6 +1763,14 @@ update_counter_do(Opts) ->
OrdSet = ets_new(ordered_set,[ordered_set | Opts]),
update_counter_for(Set),
update_counter_for(OrdSet),
+ ets:delete_all_objects(Set),
+ ets:delete_all_objects(OrdSet),
+ ets:safe_fixtable(Set, true),
+ ets:safe_fixtable(OrdSet, true),
+ update_counter_for(Set),
+ update_counter_for(OrdSet),
+ ets:safe_fixtable(Set, false),
+ ets:safe_fixtable(OrdSet, false),
ets:delete(Set),
ets:delete(OrdSet),
update_counter_neg(Opts).
@@ -1780,10 +1790,14 @@ update_counter_for(T) ->
?line {NewObj, Ret} = uc_mimic(Obj,Arg3),
ArgHash = erlang:phash2({T,a,Arg3}),
%%io:format("update_counter(~p, ~p, ~p) expecting ~p\n",[T,a,Arg3,Ret]),
+ [DefaultObj] = ets:lookup(T, a),
?line Ret = ets:update_counter(T,a,Arg3),
+ Ret = ets:update_counter(T, b, Arg3, DefaultObj), % Use other key
?line ArgHash = erlang:phash2({T,a,Arg3}),
%%io:format("NewObj=~p~n ",[NewObj]),
?line [NewObj] = ets:lookup(T,a),
+ true = ets:lookup(T, b) =:= [setelement(1, NewObj, b)],
+ ets:delete(T, b),
Myself(NewObj,Times-1,Arg3,Myself)
end,
@@ -2008,6 +2022,44 @@ evil_counter_1(Iter, T) ->
ets:update_counter(T, dracula, 1),
evil_counter_1(Iter-1, T).
+update_counter_with_default(Config) when is_list(Config) ->
+ repeat_for_opts(update_counter_with_default_do).
+
+update_counter_with_default_do(Opts) ->
+ T1 = ets_new(a, [set | Opts]),
+ %% Insert default object.
+ 3 = ets:update_counter(T1, foo, 2, {beaufort,1}),
+ %% Increment.
+ 5 = ets:update_counter(T1, foo, 2, {cabecou,1}),
+ %% Increment with list.
+ [9] = ets:update_counter(T1, foo, [{2,4}], {camembert,1}),
+ %% Same with non-immediate key.
+ 3 = ets:update_counter(T1, {foo,bar}, 2, {{chaource,chevrotin},1}),
+ 5 = ets:update_counter(T1, {foo,bar}, 2, {{cantal,comté},1}),
+ [9] = ets:update_counter(T1, {foo,bar}, [{2,4}], {{emmental,de,savoie},1}),
+ %% Same with ordered set.
+ T2 = ets_new(b, [ordered_set | Opts]),
+ 3 = ets:update_counter(T2, foo, 2, {maroilles,1}),
+ 5 = ets:update_counter(T2, foo, 2, {mimolette,1}),
+ [9] = ets:update_counter(T2, foo, [{2,4}], {morbier,1}),
+ 3 = ets:update_counter(T2, {foo,bar}, 2, {{laguiole},1}),
+ 5 = ets:update_counter(T2, {foo,bar}, 2, {{saint,nectaire},1}),
+ [9] = ets:update_counter(T2, {foo,bar}, [{2,4}], {{rocamadour},1}),
+ %% Arithmetically-equal keys.
+ 3 = ets:update_counter(T2, 1.0, 2, {1,1}),
+ 5 = ets:update_counter(T2, 1, 2, {1,1}),
+ 7 = ets:update_counter(T2, 1, 2, {1.0,1}),
+ %% Same with reversed type difference.
+ 3 = ets:update_counter(T2, 2, 2, {2.0,1}),
+ 5 = ets:update_counter(T2, 2.0, 2, {2.0,1}),
+ 7 = ets:update_counter(T2, 2.0, 2, {2,1}),
+ %% bar is not an integer.
+ {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, 3, {saint,félicien})),
+ %% No third element in default value.
+ {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, [{3,1}], {roquefort,1})),
+
+ ok.
+
fixtable_next(doc) ->
["Check that a first-next sequence always works on a fixed table"];
fixtable_next(suite) ->
@@ -3779,6 +3831,7 @@ match_object_do(Opts) ->
?line ets:insert(Tab,{{one,5},5}),
?line ets:insert(Tab,{{two,4},4}),
?line ets:insert(Tab,{{two,5},6}),
+ ?line ets:insert(Tab, {#{camembert=>cabécou},7}),
?line case ets:match_object(Tab, {{one, '_'}, '$0'}) of
[{{one,5},5},{{one,4},4}] -> ok;
[{{one,4},4},{{one,5},5}] -> ok;
@@ -3799,6 +3852,10 @@ match_object_do(Opts) ->
[{{two,4},4},{{two,5},6}] -> ok;
_ -> ?t:fail("ets:match_object() returned something funny.")
end,
+ % Check that maps are inspected for variables.
+ [{#{camembert:=cabécou},7}] =
+ ets:match_object(Tab, {#{camembert=>'_'},7}),
+ {'EXIT',{badarg,_}} = (catch ets:match_object(Tab, {#{'$1'=>'_'},7})),
% Check that unsucessful match returns an empty list.
?line [] = ets:match_object(Tab, {{three,'$0'}, '$92'}),
% Check that '$0' equals '_'.
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 4173a40d14..0b7b96da8e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -3418,7 +3418,8 @@ lookup2(Config) when is_list(Config) ->
end, [{1},{2}])">>
],
- ?line run(Config, Ts),
+
+ ok = run(Config, Ts),
TsR = [
%% is_record/2,3:
@@ -3456,7 +3457,8 @@ lookup2(Config) when is_list(Config) ->
end, [{keypos,1}], [#r{}])">>
],
- ?line run(Config, <<"-record(r, {a}).\n">>, TsR),
+
+ ok = run(Config, <<"-record(r, {a}).\n">>, TsR),
Ts2 = [
<<"etsc(fun(E) ->
@@ -3566,7 +3568,6 @@ lookup2(Config) when is_list(Config) ->
[{1,2},{2,2}] = qlc:e(Q),
[2] = lookup_keys(Q)
end, [{keypos,1}], [{1},{2},{3}])">>,
-
<<"%% Matchspec only. No cache.
etsc(fun(E) ->
Q = qlc:q([{X,Y} ||
@@ -3578,7 +3579,7 @@ lookup2(Config) when is_list(Config) ->
{generate,_,
{table,{ets,_,[_,[{traverse,_}]]}}}],[]} =
i(Q),
- [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q),
+ [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)),
false = lookup_keys(Q)
end, [{keypos,1}], [{1},{2},{3}])">>,
<<"%% Matchspec only. Cache
@@ -3592,7 +3593,7 @@ lookup2(Config) when is_list(Config) ->
{generate,_,{qlc,_,
[{generate,_,{table,{ets,_,[_,[{traverse,_}]]}}}],
[{cache,ets}]}}],[]} = i(Q),
- [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q),
+ [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)),
false = lookup_keys(Q)
end, [{keypos,1}], [{1},{2},{3}])">>,
<<"%% An empty list. Always unique and cached.
@@ -3645,7 +3646,7 @@ lookup2(Config) when is_list(Config) ->
],
- ?line run(Config, Ts2),
+ ok = run(Config, Ts2),
LTs = [
<<"etsc(fun(E) ->
@@ -3677,7 +3678,8 @@ lookup2(Config) when is_list(Config) ->
end, [{1,a},{2,b}])">>
],
- ?line run(Config, LTs),
+
+ ok = run(Config, LTs),
ok.
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index a57641ef62..d168a9d9bc 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -23,7 +23,7 @@
bad_zip/1, unzip_from_binary/1, unzip_to_binary/1,
zip_to_binary/1,
unzip_options/1, zip_options/1, list_dir_options/1, aliases/1,
- openzip_api/1, zip_api/1, unzip_jar/1,
+ openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
compress_control/1,
foldl/1]).
@@ -38,7 +38,7 @@ all() ->
[borderline, atomic, bad_zip, unzip_from_binary,
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
- zip_api, unzip_jar, compress_control, foldl].
+ zip_api, open_leak, unzip_jar, compress_control, foldl].
groups() ->
[].
@@ -318,8 +318,46 @@ zip_api(Config) when is_list(Config) ->
%% Clean up.
delete_files([Names]),
+ ok.
+
+open_leak(doc) ->
+ ["Test that zip doesn't leak processes and ports where the "
+ "controlling process dies without closing an zip opened with "
+ "zip:zip_open/1."];
+open_leak(suite) -> [];
+open_leak(Config) when is_list(Config) ->
+ %% Create a zip archive
+ Zip = "zip.zip",
+ {ok, Zip} = zip:zip(Zip, [], []),
+
+ %% Open archive in a another process that dies immediately.
+ ZipSrv = spawn_zip(Zip, [memory]),
+
+ %% Expect the ZipSrv process to die soon after.
+ true = spawned_zip_dead(ZipSrv),
+
+ %% Clean up.
+ delete_files([Zip]),
+
ok.
+spawn_zip(Zip, Options) ->
+ Self = self(),
+ spawn(fun() -> Self ! zip:zip_open(Zip, Options) end),
+ receive
+ {ok, ZipSrv} ->
+ ZipSrv
+ end.
+
+spawned_zip_dead(ZipSrv) ->
+ Ref = monitor(process, ZipSrv),
+ receive
+ {'DOWN', Ref, _, ZipSrv, _} ->
+ true
+ after 1000 ->
+ false
+ end.
+
unzip_options(doc) ->
["Test options for unzip, only cwd and file_list currently"];
unzip_options(suite) ->
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 0e685a2d8a..b5e2d06aa6 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -404,15 +404,6 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,
}).
run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
- {ok,Cwd} = file:get_cwd(),
- Args2Print = case Args of
- [Args1] when is_list(Args1) ->
- lists:keydelete(tc_group_result, 1, Args1);
- _ ->
- Args
- end,
- print(minor, "Test case started with:\n~w:~w(~tp)\n", [Mod,Func,Args2Print]),
- print(minor, "Current directory is ~tp\n", [Cwd]),
print_timestamp(minor,"Started at "),
print(minor, "", [], internal_raw),
TCCallback = get(test_server_testcase_callback),
@@ -687,7 +678,7 @@ handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St)
Msg = {E,AbortReason},
{Msg,Loc0,Msg};
Other ->
- {Other,unknown,Other}
+ {{'EXIT',Other},unknown,Other}
end,
Timeout = end_conf_timeout(Reason, St),
Config = [{tc_status,{failed,F}}|Config0],
@@ -701,7 +692,7 @@ handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid,
{testcase_aborted=E,AbortReason,Loc0} ->
{{E,AbortReason},Loc0};
Other ->
- {Other,St#st.last_known_loc}
+ {{'EXIT',Other},St#st.last_known_loc}
end,
Func = case Status of
init_per_testcase=F -> {F,Func0};
@@ -738,18 +729,16 @@ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
EndConfApply =
fun() ->
timetrap(TVal),
- case catch apply(Mod,
- end_per_testcase,
- [Func,Conf]) of
- {'EXIT',Why} ->
+ try apply(Mod,end_per_testcase,[Func,Conf]) of
+ _ -> ok
+ catch
+ _:Why ->
timer:sleep(1),
group_leader() ! {printout,12,
"WARNING! "
"~w:end_per_testcase(~w, ~p)"
" crashed!\n\tReason: ~p\n",
- [Mod,Func,Conf,Why]};
- _ ->
- ok
+ [Mod,Func,Conf,Why]}
end,
Supervisor ! {self(),end_conf}
end,
@@ -778,13 +767,11 @@ spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,
Skip = {skip,{failed,{Mod,init_per_testcase,Why}}},
%% if init_per_testcase fails, the test case
%% should be skipped
- case catch do_end_tc_call(Mod,Func,
- {Pid,Skip,[CurrConf]},
- Why) of
- {'EXIT',FwEndTCErr} ->
- exit({fw_notify_done,end_tc,FwEndTCErr});
- _ ->
- ok
+ try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of
+ _ -> ok
+ catch
+ _:FwEndTCErr ->
+ exit({fw_notify_done,end_tc,FwEndTCErr})
end,
%% finished, report back
SendTo ! {self(),fw_notify_done,
@@ -812,12 +799,12 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid,
" failed!\n\tReason: timetrap timeout"
" after ~w ms!\n", [Mod,Func,EndConf,TVal]},
FailLoc = proplists:get_value(tc_fail_loc, EndConf),
- case catch do_end_tc_call(Mod,Func,
+ try do_end_tc_call(Mod,Func,
{Pid,Report,[EndConf]}, Why) of
- {'EXIT',FwEndTCErr} ->
- exit({fw_notify_done,end_tc,FwEndTCErr});
- _ ->
- ok
+ _ -> ok
+ catch
+ _:FwEndTCErr ->
+ exit({fw_notify_done,end_tc,FwEndTCErr})
end,
Warn = "<font color=\"red\">"
"WARNING: end_per_testcase timed out!</font>",
@@ -853,21 +840,21 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
end,
FwCall =
fun() ->
- case catch fw_error_notify(Mod,Func1,[],
- Error,Loc) of
- {'EXIT',FwErrorNotifyErr} ->
+ try fw_error_notify(Mod,Func1,[],
+ Error,Loc) of
+ _ -> ok
+ catch
+ _:FwErrorNotifyErr ->
exit({fw_notify_done,error_notification,
- FwErrorNotifyErr});
- _ ->
- ok
+ FwErrorNotifyErr})
end,
Conf = [{tc_status,{failed,Error}}|CurrConf],
- case catch do_end_tc_call(Mod,Func1,
- {Pid,Error,[Conf]},Error) of
- {'EXIT',FwEndTCErr} ->
- exit({fw_notify_done,end_tc,FwEndTCErr});
- _ ->
- ok
+ try do_end_tc_call(Mod,Func1,
+ {Pid,Error,[Conf]},Error) of
+ _ -> ok
+ catch
+ _:FwEndTCErr ->
+ exit({fw_notify_done,end_tc,FwEndTCErr})
end,
%% finished, report back
SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
@@ -1358,8 +1345,8 @@ fw_error_notify(Mod, Func, Args, Error, Loc) ->
%% Just like io:format, except that depending on the Detail value, the output
%% is directed to console, major and/or minor log files.
-print(Detail,Format,Args) ->
- test_server_ctrl:print(Detail, Format, Args).
+%% print(Detail,Format,Args) ->
+%% test_server_ctrl:print(Detail, Format, Args).
print(Detail,Format,Args,Printer) ->
test_server_ctrl:print(Detail, Format, Args, Printer).
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 488f38d05d..68b03a5987 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -1808,20 +1808,32 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
put(test_server_minor_footer, Footer),
io:put_chars(Fd, Header),
+ io:put_chars(Fd, "<a name=\"top\"></a>"),
+ io:put_chars(Fd, "<pre>\n"),
+
SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
+
+ {Info,Arity} =
+ if Func == init_per_suite; Func == end_per_suite ->
+ {"Config function: ", 1};
+ Func == init_per_group; Func == end_per_group ->
+ {"Config function: ", 2};
+ true ->
+ {"Test case: ", 1}
+ end,
+
case {filelib:is_file(filename:join(LogDir, SrcListing)),
lists:member(no_src, get(test_server_logopts))} of
{true,false} ->
- print(Lev, "<a href=\"~ts#~ts\">source code for ~w:~w/1</a>\n",
+ print(Lev, Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> "
+ "(click for source code)\n",
[uri_encode(SrcListing),
uri_encode(atom_to_list(Func)++"-1",utf8),
- Mod,Func]);
+ Mod,Func,Arity]);
_ ->
- ok
+ print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity])
end,
- io:put_chars(Fd, "<pre>\n"),
-
AbsName.
stop_minor_log_file() ->
@@ -3076,13 +3088,11 @@ print_conf_time(ConfTime) ->
print(major, "=group_time ~.3fs", [ConfTime]),
print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).
-print_props(_, []) ->
+print_props([]) ->
ok;
-print_props(true, Props) ->
+print_props(Props) ->
print(major, "=group_props ~p", [Props]),
- print(minor, "Group properties: ~p~n", [Props]);
-print_props(_, _) ->
- ok.
+ print(minor, "Group properties: ~p~n", [Props]).
%% repeat N times: {repeat,N}
%% repeat N times or until all successful: {repeat_until_all_ok,N}
@@ -3687,7 +3697,6 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
print(major, "=case ~w:~w", [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)]),
@@ -3720,7 +3729,20 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
[tc_start,{{Mod,{Func,GrName}},
MinorName}]),
- print_props((RunInit==skip_init), get_props(Mode)),
+ {ok,Cwd} = file:get_cwd(),
+ Args2Print = if is_list(UpdatedArgs) ->
+ lists:keydelete(tc_group_result, 1, UpdatedArgs);
+ true ->
+ UpdatedArgs
+ end,
+ if RunInit == skip_init ->
+ print_props(get_props(Mode));
+ true ->
+ ok
+ end,
+ print(minor, "Config value:\n\n ~tp\n", [Args2Print]),
+ print(minor, "Current directory is ~tp\n", [Cwd]),
+
GrNameStr = case GrName of
undefined -> "";
Name -> cast_to_list(Name)
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index bc62015ac3..594e619fbc 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -18,7 +18,6 @@
%%
-module(ts_install).
-
-export([install/2, platform_id/1]).
-include("ts.hrl").
@@ -135,15 +134,63 @@ unix_autoconf(XConf) ->
case filelib:is_file(Configure) of
true ->
OSXEnv = macosx_cflags(),
+ UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)),
io:format("Running ~s~nEnv: ~p~n",
- [lists:flatten(Configure ++ Args),Env++OSXEnv]),
+ [lists:flatten(Configure ++ Args),UnQuotedEnv]),
Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])},
- [stream, eof, {env,Env++OSXEnv}]),
+ [stream, eof, {env,UnQuotedEnv}]),
ts_lib:print_data(Port);
false ->
{error, no_configure_script}
end.
+unquote([{Var,Val}|T]) ->
+ [{Var,unquote(Val)}|unquote(T)];
+unquote([]) ->
+ [];
+unquote("\""++Rest) ->
+ lists:reverse(tl(lists:reverse(Rest)));
+unquote(String) ->
+ String.
+
+assign_vars([]) ->
+ [];
+assign_vars([{VAR,FlagsStr} | VARs]) ->
+ [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)];
+assign_vars(FlagsStr) ->
+ Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])],
+ string:strip(lists:flatten(lists:map(fun(Flag) ->
+ Flag ++ " "
+ end, Flags)), right).
+
+assign_all_vars([$$ | Rest], FlagSoFar) ->
+ {VarName,Rest1} = get_var_name(Rest, []),
+ assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName));
+assign_all_vars([Char | Rest], FlagSoFar) ->
+ assign_all_vars(Rest, FlagSoFar ++ [Char]);
+assign_all_vars([], Flag) ->
+ Flag.
+
+get_var_name([Ch | Rest] = Str, VarR) ->
+ case valid_char(Ch) of
+ true -> get_var_name(Rest, [Ch | VarR]);
+ false -> {lists:reverse(VarR),Str}
+ end;
+get_var_name([], VarR) ->
+ {lists:reverse(VarR),[]}.
+
+assign_var(VarName) ->
+ case os:getenv(VarName) of
+ false -> "";
+ Val -> Val
+ end.
+
+valid_char(Ch) when Ch >= $a, Ch =< $z -> true;
+valid_char(Ch) when Ch >= $A, Ch =< $Z -> true;
+valid_char(Ch) when Ch >= $0, Ch =< $9 -> true;
+valid_char($_) -> true;
+valid_char(_) -> false.
+
get_xcomp_flag(Flag, Flags) ->
get_xcomp_flag(Flag, Flag, Flags).
get_xcomp_flag(Flag, Tag, Flags) ->
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index c56759ebb9..0c003bab39 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -4743,6 +4743,23 @@ for a tag on the form `module:tag'."
;;; `module:tag'.
+(when (and (fboundp 'etags-tags-completion-table)
+ (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
+ (if (fboundp 'advice-add)
+ ;; Emacs 24.4+
+ (advice-add 'etags-tags-completion-table :around
+ (lambda (oldfun)
+ (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
+ (erlang-etags-tags-completion-table)
+ (funcall oldfun)))
+ (list :name 'erlang-replace-tags-table))
+ ;; Emacs 23.1-24.3
+ (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate)
+ (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
+ (setq ad-return-value (erlang-etags-tags-completion-table))
+ ad-do-it))))
+
+
(defun erlang-complete-tag ()
"Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
@@ -4754,7 +4771,17 @@ about Erlang modules."
(require 'etags)
(error nil))
(cond ((and erlang-tags-installed
- (fboundp 'complete-tag)) ; Emacs 19
+ (fboundp 'etags-tags-completion-table)
+ (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
+ ;; This depends on the advice called erlang-replace-tags-table
+ ;; above. It is not enough to let-bind
+ ;; tags-completion-table-function since that will not override
+ ;; the buffer-local value in the TAGS buffer.
+ (let ((find-tag-default-function 'erlang-find-tag-for-completion))
+ (complete-tag)))
+ ((and erlang-tags-installed
+ (fboundp 'complete-tag)
+ (fboundp 'tags-complete-tag)) ; Emacs 19
(let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
(fset 'tags-complete-tag
(symbol-function 'erlang-tags-complete-tag))
@@ -4769,6 +4796,15 @@ about Erlang modules."
(error "This version of Emacs can't complete tags"))))
+(defun erlang-find-tag-for-completion ()
+ (let ((start (save-excursion
+ (skip-chars-backward "[:word:][:digit:]_:'")
+ (point))))
+ (unless (eq start (point))
+ (buffer-substring-no-properties start (point)))))
+
+
+
;; Based on `tags-complete-tag', but this one uses
;; `erlang-tags-completion-table' instead of `tags-completion-table'.
;;
@@ -4816,7 +4852,12 @@ about Erlang modules."
;; the only format supported by Emacs, so far.)
(defun erlang-etags-tags-completion-table ()
(let ((table (make-vector 511 0))
- (file nil))
+ (file nil)
+ (progress-reporter
+ (when (fboundp 'make-progress-reporter)
+ (make-progress-reporter
+ (format "Making erlang tags completion table for %s..." buffer-file-name)
+ (point-min) (point-max)))))
(save-excursion
(goto-char (point-min))
;; This monster regexp matches an etags tag line.
@@ -4828,31 +4869,33 @@ about Erlang modules."
;; \6 is the line to start searching at;
;; \7 is the char to start searching at.
(while (progn
- (while (and
- (eq (following-char) ?\f)
- (looking-at "\f\n\\([^,\n]*\\),.*\n"))
- (setq file (buffer-substring
- (match-beginning 1) (match-end 1)))
- (goto-char (match-end 0)))
- (re-search-forward
- "\
+ (while (and
+ (eq (following-char) ?\f)
+ (looking-at "\f\n\\([^,\n]*\\),.*\n"))
+ (setq file (buffer-substring
+ (match-beginning 1) (match-end 1)))
+ (goto-char (match-end 0)))
+ (re-search-forward
+ "\
^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
\\([0-9]+\\)?,\\([0-9]+\\)?\n"
- nil t))
- (let ((tag (if (match-beginning 5)
- ;; There is an explicit tag name.
- (buffer-substring (match-beginning 5) (match-end 5))
- ;; No explicit tag name. Best guess.
- (buffer-substring (match-beginning 3) (match-end 3))))
- (module (and file
- (erlang-get-module-from-file-name file))))
- (intern tag table)
- (if (stringp module)
- (progn
- (intern (concat module ":" tag) table)
- ;; Only the first one will be stored in the table.
- (intern (concat module ":") table))))))
+ nil t))
+ (let ((tag (if (match-beginning 5)
+ ;; There is an explicit tag name.
+ (buffer-substring (match-beginning 5) (match-end 5))
+ ;; No explicit tag name. Best guess.
+ (buffer-substring (match-beginning 3) (match-end 3))))
+ (module (and file
+ (erlang-get-module-from-file-name file))))
+ (intern tag table)
+ (when (stringp module)
+ (intern (concat module ":" tag) table)
+ ;; Only the first ones will be stored in the table.
+ (intern (concat module ":") table)
+ (intern (concat module ":module_info") table))
+ (when progress-reporter
+ (progress-reporter-update progress-reporter (point))))))
table))
;;;
diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl
index e3cc51cdb2..e25db2eb1b 100644
--- a/lib/tools/src/tags.erl
+++ b/lib/tools/src/tags.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2015. 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
@@ -297,15 +297,16 @@ word_char(_) -> false.
%% Check the options `outfile' and `outdir'.
open_out(Options) ->
+ Opts = [write, {encoding, unicode}],
case lists:keysearch(outfile, 1, Options) of
{value, {outfile, File}} ->
- file:open(File, [write]);
+ file:open(File, Opts);
_ ->
case lists:keysearch(outdir, 1, Options) of
{value, {outdir, Dir}} ->
- file:open(filename:join(Dir, "TAGS"), [write]);
+ file:open(filename:join(Dir, "TAGS"), Opts);
_ ->
- file:open("TAGS", [write])
+ file:open("TAGS", Opts)
end
end.