aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/src/common_test.app.src1
-rw-r--r--lib/common_test/test/Makefile3
-rw-r--r--lib/common_test/test/ct_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl112
-rw-r--r--lib/compiler/src/compile.erl30
-rw-r--r--lib/compiler/test/lc_SUITE.erl9
-rw-r--r--lib/crypto/src/crypto.erl7
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl113
-rw-r--r--lib/dialyzer/src/dialyzer_behaviours.erl13
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl94
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl14
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl204
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl52
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl22
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl3
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl130
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl33
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl54
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl118
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/chars4
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/anno.erl18
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/chars.erl32
-rw-r--r--lib/eldap/test/Makefile2
-rw-r--r--lib/eldap/test/eldap.cover3
-rw-r--r--lib/hipe/cerl/erl_types.erl191
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_num_bif.erl217
-rw-r--r--lib/hipe/test/hipe_SUITE.erl6
-rw-r--r--lib/hipe/test/opt_verify_SUITE.erl39
-rw-r--r--lib/inets/doc/src/httpc.xml2
-rw-r--r--lib/inets/src/http_client/httpc.erl92
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl674
-rw-r--r--lib/inets/src/http_client/httpc_response.erl2
-rw-r--r--lib/inets/test/httpc_SUITE.erl71
-rw-r--r--lib/kernel/doc/src/heart.xml17
-rw-r--r--lib/kernel/src/heart.erl15
-rw-r--r--lib/observer/src/crashdump_viewer.erl21
-rw-r--r--lib/observer/src/etop.erl24
-rw-r--r--lib/observer/src/etop_txt.erl24
-rw-r--r--lib/observer/src/observer_lib.erl14
-rw-r--r--lib/observer/src/observer_pro_wx.erl8
-rw-r--r--lib/runtime_tools/src/observer_backend.erl7
-rwxr-xr-xlib/sasl/test/release_handler_SUITE_data/start3
-rwxr-xr-xlib/sasl/test/release_handler_SUITE_data/start_client3
-rw-r--r--lib/ssh/src/ssh_auth.erl6
-rw-r--r--lib/ssh/src/ssh_sftpd_file_api.erl2
-rw-r--r--lib/ssh/test/property_test/ssh_eqc_encode_decode.erl365
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl8
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl11
-rw-r--r--lib/ssh/test/ssh_property_test_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE.erl4
-rw-r--r--lib/ssh/test/ssh_test_lib.erl47
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE.erl4
-rw-r--r--lib/ssl/doc/src/ssl.xml8
-rw-r--r--lib/ssl/src/ssl.erl8
-rw-r--r--lib/ssl/src/ssl_connection.erl11
-rw-r--r--lib/ssl/src/ssl_handshake.hrl3
-rw-r--r--lib/ssl/src/ssl_internal.hrl3
-rw-r--r--lib/ssl/src/tls_connection.erl50
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl26
-rw-r--r--lib/stdlib/src/erl_eval.erl1
-rw-r--r--lib/stdlib/src/erl_parse.yrl11
-rw-r--r--lib/stdlib/src/escript.erl83
-rw-r--r--lib/stdlib/test/escript_SUITE.erl15
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/two_lines2
-rw-r--r--lib/stdlib/test/rand_SUITE.erl6
-rw-r--r--lib/stdlib/test/shell_SUITE.erl2
-rw-r--r--lib/typer/src/typer.erl22
-rw-r--r--lib/xmerl/src/xmerl_scan.erl22
-rw-r--r--lib/xmerl/test/xmerl_SUITE.erl18
69 files changed, 1872 insertions, 1423 deletions
diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src
index 77588af59b..dfa321c901 100644
--- a/lib/common_test/src/common_test.app.src
+++ b/lib/common_test/src/common_test.app.src
@@ -22,6 +22,7 @@
{vsn, "%VSN%"},
{modules, [ct_cover,
ct,
+ ct_default_gl,
ct_event,
ct_framework,
ct_ftp,
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index b1eddfedd7..2f0fc2e05a 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -70,7 +70,8 @@ MODULES= \
test_server_SUITE \
test_server_test_lib \
ct_release_test_SUITE \
- ct_log_SUITE
+ ct_log_SUITE \
+ ct_SUITE
ERL_FILES= $(MODULES:%=%.erl)
HRL_FILES= test_server_test_lib.hrl
diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl
new file mode 100644
index 0000000000..eb98c2544f
--- /dev/null
+++ b/lib/common_test/test/ct_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ct_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [app_file, appup_file].
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+
+app_file(_Config) ->
+ ok = test_server:app_test(common_test),
+ ok.
+
+appup_file(_Config) ->
+ ok = test_server:appup_test(common_test).
+
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 690d0af1bb..bc716fb5e3 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -70,20 +70,20 @@ suite() ->
all() ->
all(suite).
-all(suite) ->
+all(suite) ->
lists:reverse(
[
one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init,
faulty_cth_exit_in_init, faulty_cth_exit_in_id,
- faulty_cth_exit_in_init_scope_suite, minimal_cth,
- minimal_and_maximal_cth, faulty_cth_undef,
+ faulty_cth_exit_in_init_scope_suite, minimal_cth,
+ minimal_and_maximal_cth, faulty_cth_undef,
scope_per_suite_cth, scope_per_group_cth, scope_suite_cth,
- scope_per_suite_state_cth, scope_per_group_state_cth,
+ scope_per_suite_state_cth, scope_per_group_state_cth,
scope_suite_state_cth,
fail_pre_suite_cth, double_fail_pre_suite_cth,
fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth,
skip_post_suite_cth, recover_post_suite_cth, update_config_cth,
- state_update_cth, options_cth, same_id_cth,
+ state_update_cth, options_cth, same_id_cth,
fail_n_skip_with_minimal_cth, prio_cth, no_config,
data_dir, cth_log
]
@@ -96,10 +96,10 @@ all(suite) ->
%%%-----------------------------------------------------------------
%%%
-one_cth(Config) when is_list(Config) ->
+one_cth(Config) when is_list(Config) ->
do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config).
-two_cth(Config) when is_list(Config) ->
+two_cth(Config) when is_list(Config) ->
do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth],
Config).
@@ -119,13 +119,13 @@ minimal_cth(Config) when is_list(Config) ->
minimal_and_maximal_cth(Config) when is_list(Config) ->
do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl",
[minimal_cth, empty_cth],Config).
-
+
faulty_cth_undef(Config) when is_list(Config) ->
do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl",
[undef_cth],Config).
faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) ->
- do_test(faulty_cth_exit_in_init_scope_suite,
+ do_test(faulty_cth_exit_in_init_scope_suite,
"ct_exit_in_init_scope_suite_cth_SUITE.erl",
[],Config).
@@ -205,7 +205,7 @@ state_update_cth(Config) when is_list(Config) ->
options_cth(Config) when is_list(Config) ->
do_test(options_cth, "ct_cth_empty_SUITE.erl",
[{empty_cth,[test]}],Config).
-
+
same_id_cth(Config) when is_list(Config) ->
do_test(same_id_cth, "ct_cth_empty_SUITE.erl",
[same_id_cth,same_id_cth],Config).
@@ -227,9 +227,10 @@ data_dir(Config) when is_list(Config) ->
do_test(data_dir, "ct_data_dir_SUITE.erl",
[verify_data_dir_cth],Config).
-cth_log(Config) when is_list(Config) ->
+cth_log(Config) when is_list(Config) ->
%% test that cth_log_redirect writes properly to
%% unexpected I/O log
+ ct:timetrap({minutes,10}),
StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config),
Logdir = proplists:get_value(logdir, StartOpts),
UnexpIoLogs =
@@ -266,7 +267,6 @@ do_test(Tag, SWC, CTHs, Config, Res) ->
do_test(Tag, SWC, CTHs, Config, Res, 2).
do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) ->
-
DataDir = ?config(data_dir, Config),
Suites = filelib:wildcard(
filename:join([DataDir,"cth/tests",SuiteWildCard])),
@@ -275,7 +275,7 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) ->
Res = ct_test_support:run(Opts, Config),
Events = ct_test_support:get_events(ERPid, Config),
- ct_test_support:log_events(Tag,
+ ct_test_support:log_events(Tag,
reformat(Events, ?eh),
?config(priv_dir, Config),
Opts),
@@ -328,7 +328,7 @@ test_events(one_empty_cth) ->
{?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -360,7 +360,7 @@ test_events(two_empty_cth) ->
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -402,7 +402,7 @@ test_events(minimal_cth) ->
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -426,7 +426,7 @@ test_events(minimal_and_maximal_cth) ->
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}},
@@ -452,11 +452,11 @@ test_events(faulty_cth_undef) ->
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed, FailReason}}},
{?eh,cth,{'_',on_tc_skip,'_'}},
-
+
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite,
{failed, FailReason}}},
{?eh,cth,{'_',on_tc_skip,'_'}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -515,7 +515,7 @@ test_events(scope_per_suite_cth) ->
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_scope_per_suite_cth_SUITE,'$proplist',[]]}},
@@ -541,7 +541,7 @@ test_events(scope_suite_cth) ->
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}},
@@ -563,18 +563,18 @@ test_events(scope_per_group_cth) ->
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}},
{?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}},
{?eh,cth,{'_',terminate,[[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}],
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -595,7 +595,7 @@ test_events(scope_per_suite_state_cth) ->
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}},
@@ -621,7 +621,7 @@ test_events(scope_suite_state_cth) ->
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}},
@@ -643,18 +643,18 @@ test_events(scope_per_group_state_cth) ->
{?eh,cth,{'_',init,['_',[test]]}},
{?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}},
{?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}},
{?eh,cth,{'_',terminate,[[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}],
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -666,7 +666,7 @@ test_events(fail_pre_suite_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',
@@ -676,7 +676,7 @@ test_events(fail_pre_suite_cth) ->
{?eh,cth,{'_',on_tc_fail,
[init_per_suite,{failed,"Test failure"},[]]}},
-
+
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
@@ -685,7 +685,7 @@ test_events(fail_pre_suite_cth) ->
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}},[]]}},
-
+
{?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}}},
@@ -694,7 +694,7 @@ test_events(fail_pre_suite_cth) ->
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}},[]]}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth, {'_',terminate,[[]]}},
{?eh,stop_logging,[]}
@@ -733,7 +733,7 @@ test_events(fail_post_suite_cth) ->
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
{?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}},
-
+
{?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}}},
@@ -758,7 +758,7 @@ test_events(skip_pre_suite_cth) ->
{?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}},
{?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}},
-
+
{?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -772,18 +772,18 @@ test_events(skip_pre_end_cth) ->
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}},
-
+
[{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}},
{?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}},
@@ -808,7 +808,7 @@ test_events(skip_post_suite_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
@@ -818,9 +818,9 @@ test_events(skip_post_suite_cth) ->
{?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}},
{?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}},
-
+
{?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[[]]}},
{?eh,stop_logging,[]}
@@ -844,7 +844,7 @@ test_events(recover_post_suite_cth) ->
{?eh,cth,{'_',post_end_per_testcase,
[test_case, contains([tc_status]),'_',[]]}},
{?eh,tc_done,{Suite,test_case,ok}},
-
+
{?eh,tc_start,{Suite,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[Suite,not_contains([tc_status]),[]]}},
@@ -861,7 +861,7 @@ test_events(update_config_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_update_config_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,
[ct_update_config_SUITE,contains([]),[]]}},
@@ -941,7 +941,7 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
ok,[]]}},
{?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_update_config_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_update_config_SUITE,contains(
@@ -974,7 +974,7 @@ test_events(state_update_cth) ->
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{'_',init_per_suite}},
-
+
{?eh,tc_done,{'_',end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[contains(
@@ -1021,7 +1021,7 @@ test_events(options_cth) ->
{?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
[ct_cth_empty_SUITE,'$proplist',[test]]}},
@@ -1058,7 +1058,7 @@ test_events(same_id_cth) ->
{negative,
{?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{negative,
@@ -1115,17 +1115,14 @@ test_events(fail_n_skip_with_minimal_cth) ->
];
test_events(prio_cth) ->
-
GenPre = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_',State]}} ||
- State <- States]
+ [{?eh,cth,{'_',Func,['_','_',State]}} || State <- States]
end,
GenPost = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
- State <- States]
+ [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States]
end,
-
+
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++
@@ -1136,7 +1133,7 @@ test_events(prio_cth) ->
[[1100,100],[600,200],[600,600],[700],[800],[900],[1000],
[1200,1050],[1100],[1200]]) ++
[{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}},
-
+
[{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++
GenPre(pre_init_per_group,
@@ -1147,7 +1144,7 @@ test_events(prio_cth) ->
[900],[900,900],[500,900],[1000],[1200,1050],
[1100],[1200]]) ++
[{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++
-
+
[{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++
GenPre(pre_init_per_testcase,
[[1100,100],[600,200],[600,600],[600],[700],[800],
@@ -1161,7 +1158,7 @@ test_events(prio_cth) ->
[{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}},
{?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++
- GenPre(pre_end_per_group,
+ GenPre(pre_end_per_group,
lists:reverse(
[[1100,100],[600,200],[600,600],[600],[700],[800],
[900],[900,900],[500,900],[1000],[1200,1050],
@@ -1300,7 +1297,7 @@ test_events(cth_log) ->
[{suite,cth_log_SUITE},parallel]}}},
{?eh,tc_done,{ct_framework,{end_per_group,g1,
[{suite,cth_log_SUITE},parallel]},ok}}]},
-
+
{?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
@@ -1309,7 +1306,6 @@ test_events(cth_log) ->
test_events(ok) ->
ok.
-
%% test events help functions
contains(List) ->
fun(Proplist) when is_list(Proplist) ->
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 434360d294..e37ca31704 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -173,17 +173,25 @@ env_default_opts() ->
do_compile(Input, Opts0) ->
Opts = expand_opts(Opts0),
- {Pid,Ref} =
- spawn_monitor(fun() ->
- exit(try
- internal(Input, Opts)
- catch
- error:Reason ->
- {error,Reason}
- end)
- end),
- receive
- {'DOWN',Ref,process,Pid,Rep} -> Rep
+ IntFun = fun() -> try
+ internal(Input, Opts)
+ catch
+ error:Reason ->
+ {error,Reason}
+ end
+ end,
+ %% Dialyzer has already spawned workers.
+ case lists:member(dialyzer, Opts) of
+ true ->
+ IntFun();
+ false ->
+ {Pid,Ref} =
+ spawn_monitor(fun() ->
+ exit(IntFun())
+ end),
+ receive
+ {'DOWN',Ref,process,Pid,Rep} -> Rep
+ end
end.
expand_opts(Opts0) ->
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 3cb49433ce..adb96fb87d 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(lc_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
basic/1,deeply_nested/1,no_generator/1,
@@ -32,11 +32,11 @@ suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,1}}].
-all() ->
+all() ->
test_lib:recompile(?MODULE),
[{group,p}].
-groups() ->
+groups() ->
[{p,test_lib:parallel(),
[basic,
deeply_nested,
@@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) ->
ok.
effect(Config) when is_list(Config) ->
+ ct:timetrap({minutes,10}),
[{42,{a,b,c}}] =
do_effect(fun(F, L) ->
[F({V1,V2}) ||
@@ -240,7 +241,7 @@ do_effect(Lc, L) ->
lists:reverse(erase(?MODULE)).
id(I) -> I.
-
+
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok;
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}})
when length(Args) =:= Arity ->
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index da8626e38a..a87b480f60 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -277,10 +277,11 @@ hmac_final_n(Context, HashLen) ->
des3_cbc | des3_cbf | des3_cfb | des_ede3 |
blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 |
aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 |
- aes_cbc |
+ aes_cbc |
rc2_cbc,
- Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
- (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}.
+ Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
+ (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()};
+ (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}.
block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc;
Type =:= des_cfb;
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 08e55a78bd..4e18058993 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -101,9 +101,9 @@ loop(#server_state{parent = Parent} = State,
{AnalPid, cserver, CServer, Plt} ->
send_codeserver_plt(Parent, CServer, Plt),
loop(State, Analysis, ExtCalls);
- {AnalPid, done, Plt, DocPlt} ->
+ {AnalPid, done, MiniPlt, DocPlt} ->
send_ext_calls(Parent, ExtCalls),
- send_analysis_done(Parent, Plt, DocPlt);
+ send_analysis_done(Parent, MiniPlt, DocPlt);
{AnalPid, ext_calls, NewExtCalls} ->
loop(State, Analysis, NewExtCalls);
{AnalPid, ext_types, ExtTypes} ->
@@ -121,6 +121,7 @@ loop(#server_state{parent = Parent} = State,
%% The Analysis
%%--------------------------------------------------------------------
+%% Calls to erlang:garbage_collect() help to reduce the heap size.
analysis_start(Parent, Analysis, LegalWarnings) ->
CServer = dialyzer_codeserver:new(),
Plt = Analysis#analysis.plt,
@@ -157,12 +158,9 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0),
TmpCServer2 =
dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
+ erlang:garbage_collect(),
?timing(State#analysis_state.timing_server, "remote",
- begin
- TmpCServer3 =
- dialyzer_utils:process_record_remote_types(TmpCServer2),
- dialyzer_contracts:process_contract_remote_types(TmpCServer3)
- end)
+ contracts_and_records(TmpCServer2))
catch
throw:{error, _ErrorMsg} = Error -> exit(Error)
end,
@@ -171,48 +169,75 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes),
State0 = State#analysis_state{plt = NewPlt1},
dump_callgraph(Callgraph, State0, Analysis),
- State1 = State0#analysis_state{codeserver = NewCServer},
%% Remove all old versions of the files being analyzed
AllNodes = dialyzer_callgraph:all_nodes(Callgraph),
- Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes),
+ Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes),
+ Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer),
+ State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1},
Exports = dialyzer_codeserver:get_exports(NewCServer),
+ NonExports = sets:subtract(sets:from_list(AllNodes), Exports),
+ NonExportsList = sets:to_list(NonExports),
NewCallgraph =
case Analysis#analysis.race_detection of
true -> dialyzer_callgraph:put_race_detection(true, Callgraph);
false -> Callgraph
end,
- State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}),
+ State2 = analyze_callgraph(NewCallgraph, State1),
+ #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2,
dialyzer_callgraph:dispose_race_server(NewCallgraph),
rcv_and_send_ext_types(Parent),
- NonExports = sets:subtract(sets:from_list(AllNodes), Exports),
- NonExportsList = sets:to_list(NonExports),
- Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList),
- send_codeserver_plt(Parent, CServer, State2#analysis_state.plt),
- send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt).
+ %% Since the PLT is never used, a dummy is sent:
+ DummyPlt = dialyzer_plt:new(),
+ send_codeserver_plt(Parent, CServer, DummyPlt),
+ MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList),
+ send_analysis_done(Parent, MiniPlt3, DocPlt).
+
+contracts_and_records(CodeServer) ->
+ Fun = contrs_and_recs(CodeServer),
+ {Pid, Ref} = erlang:spawn_monitor(Fun),
+ dialyzer_codeserver:give_away(CodeServer, Pid),
+ Pid ! {self(), go},
+ receive {'DOWN', Ref, process, Pid, Return} ->
+ Return
+ end.
+
+-spec contrs_and_recs(dialyzer_codeserver:codeserver()) ->
+ fun(() -> no_return()).
+
+contrs_and_recs(TmpCServer2) ->
+ fun() ->
+ Parent = receive {Pid, go} -> Pid end,
+ {TmpCServer3, RecordDict} =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ TmpServer4 =
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3,
+ RecordDict),
+ dialyzer_codeserver:give_away(TmpServer4, Parent),
+ exit(TmpServer4)
+ end.
analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver,
doc_plt = DocPlt,
+ plt = Plt,
timing_server = TimingServer,
parent = Parent,
solvers = Solvers} = State) ->
- Plt = dialyzer_plt:insert_callbacks(State#analysis_state.plt, Codeserver),
- {NewPlt, NewDocPlt} =
- case State#analysis_state.analysis_type of
- plt_build ->
- NewPlt0 =
- dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
- TimingServer, Solvers, Parent),
- {NewPlt0, DocPlt};
- succ_typings ->
- {Warnings, NewPlt0, NewDocPlt0} =
- dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver,
- TimingServer, Solvers, Parent),
- Warnings1 = filter_warnings(Warnings, Codeserver),
- send_warnings(State#analysis_state.parent, Warnings1),
- {NewPlt0, NewDocPlt0}
- end,
- dialyzer_callgraph:delete(Callgraph),
- State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}.
+ case State#analysis_state.analysis_type of
+ plt_build ->
+ NewMiniPlt =
+ dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
+ TimingServer, Solvers, Parent),
+ dialyzer_callgraph:delete(Callgraph),
+ State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt};
+ succ_typings ->
+ {Warnings, NewMiniPlt, NewDocPlt} =
+ dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver,
+ TimingServer, Solvers, Parent),
+ dialyzer_callgraph:delete(Callgraph),
+ Warnings1 = filter_warnings(Warnings, Codeserver),
+ send_warnings(State#analysis_state.parent, Warnings1),
+ State#analysis_state{plt = NewMiniPlt, doc_plt = NewDocPlt}
+ end.
%%--------------------------------------------------------------------
%% Build the callgraph and fill the codeserver.
@@ -569,8 +594,9 @@ is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) ->
is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) ->
not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver).
-send_analysis_done(Parent, Plt, DocPlt) ->
- Parent ! {self(), done, Plt, DocPlt},
+send_analysis_done(Parent, MiniPlt, DocPlt) ->
+ ok = dialyzer_plt:give_away(MiniPlt, Parent),
+ Parent ! {self(), done, MiniPlt, DocPlt},
ok.
send_ext_calls(_Parent, none) ->
@@ -583,7 +609,7 @@ send_ext_types(Parent, ExtTypes) ->
Parent ! {self(), ext_types, ExtTypes},
ok.
-send_codeserver_plt(Parent, CServer, Plt ) ->
+send_codeserver_plt(Parent, CServer, Plt) ->
Parent ! {self(), cserver, CServer, Plt},
ok.
@@ -602,14 +628,14 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc)
format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) ->
{_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer),
Msg = {call_to_missing, [M, F, A]},
- {File, Line} = find_call_file_and_line(FunCode, To),
+ {File, Line} = find_call_file_and_line(FromMFA, FunCode, To, CodeServer),
WarningInfo = {File, Line, FromMFA},
NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc],
format_bad_calls(Left, CodeServer, NewAcc);
format_bad_calls([], _CodeServer, Acc) ->
Acc.
-find_call_file_and_line(Tree, MFA) ->
+find_call_file_and_line({Module, _, _}, Tree, MFA, CodeServer) ->
Fun =
fun(SubTree, Acc) ->
case cerl:is_c_call(SubTree) of
@@ -622,7 +648,7 @@ find_call_file_and_line(Tree, MFA) ->
case {cerl:concrete(M), cerl:concrete(F), A} of
MFA ->
Ann = cerl:get_ann(SubTree),
- [{get_file(Ann), get_line(Ann)}|Acc];
+ [{get_file(CodeServer, Module, Ann), get_line(Ann)}|Acc];
{erlang, make_fun, 3} ->
[CA1, CA2, CA3] = cerl:call_args(SubTree),
case
@@ -638,7 +664,8 @@ find_call_file_and_line(Tree, MFA) ->
of
MFA ->
Ann = cerl:get_ann(SubTree),
- [{get_file(Ann), get_line(Ann)}|Acc];
+ [{get_file(CodeServer, Module, Ann),
+ get_line(Ann)}|Acc];
_ ->
Acc
end;
@@ -658,8 +685,10 @@ get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file(Codeserver, Module, [{file, FakeFile}|_]) ->
+ dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile);
+get_file(Codeserver, Module, [_|Tail]) ->
+ get_file(Codeserver, Module, Tail).
-spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) ->
'ok'.
diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
index 5623929a43..524ae047e2 100644
--- a/lib/dialyzer/src/dialyzer_behaviours.erl
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -62,9 +62,9 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) ->
_ ->
MFA = {Module,module_info,0},
{_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
- File = get_file(cerl:get_ann(Code)),
+ File = get_file(Codeserver, Module, cerl:get_ann(Code)),
State = #state{plt = Plt, filename = File, behlines = BehLines,
- codeserver = Codeserver, records = Records},
+ codeserver = Codeserver, records = Records},
Warnings = get_warnings(Module, Behaviours, State),
[add_tag_warning_info(Module, W, State) || W <- Warnings]
end.
@@ -213,12 +213,15 @@ add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) ->
dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity},
State#state.codeserver),
Anns = cerl:get_ann(FunCode),
- WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}},
+ File = get_file(State#state.codeserver, Module, Anns),
+ WarningInfo = {File, get_line(Anns), {Module, Fun, Arity}},
{?WARN_BEHAVIOUR, WarningInfo, Warn}.
get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file(Codeserver, Module, [{file, FakeFile}|_]) ->
+ dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile);
+get_file(Codeserver, Module, [_|Tail]) ->
+ get_file(Codeserver, Module, Tail).
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index 50abb22009..5e02e7a2cc 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -119,7 +119,11 @@
-opaque callgraph() :: #callgraph{}.
--type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}.
+-type active_digraph() :: {'d', digraph:graph()}
+ | {'e',
+ Out :: ets:tid(),
+ In :: ets:tid(),
+ Map :: ets:tid()}.
%%----------------------------------------------------------------------
@@ -248,24 +252,30 @@ find_non_local_calls([], Set) ->
-spec get_depends_on(scc() | module(), callgraph()) -> [scc()].
-get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In}}) ->
- case ets_lookup_dict(SCC, Out) of
- {ok, Value} -> Value;
- error -> []
- end;
+get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) ->
+ lookup_scc(SCC, Out, Maps);
get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) ->
digraph:out_neighbours(DG, SCC).
-spec get_required_by(scc() | module(), callgraph()) -> [scc()].
-get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In}}) ->
- case ets_lookup_dict(SCC, In) of
- {ok, Value} -> Value;
- error -> []
- end;
+get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) ->
+ lookup_scc(SCC, In, Maps);
get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) ->
digraph:in_neighbours(DG, SCC).
+lookup_scc(SCC, Table, Maps) ->
+ case ets_lookup_dict({'scc', SCC}, Maps) of
+ {ok, SCCInt} ->
+ case ets_lookup_dict(SCCInt, Table) of
+ {ok, Ints} ->
+ [ets:lookup_element(Maps, Int, 2) || Int <- Ints];
+ error ->
+ []
+ end;
+ error -> []
+ end.
+
%%----------------------------------------------------------------------
%% Handling of modules & SCCs
%%----------------------------------------------------------------------
@@ -582,9 +592,10 @@ digraph_delete(DG) ->
active_digraph_delete({'d', DG}) ->
digraph:delete(DG);
-active_digraph_delete({'e', Out, In}) ->
+active_digraph_delete({'e', Out, In, Maps}) ->
ets:delete(Out),
- ets:delete(In).
+ ets:delete(In),
+ ets:delete(Maps).
digraph_edges(DG) ->
digraph:edges(DG).
@@ -758,37 +769,28 @@ to_ps(#callgraph{} = CG, File, Args) ->
ok.
condensation(G) ->
- SCs = digraph_utils:strong_components(G),
- V2I = ets:new(condensation_v2i, []),
- I2C = ets:new(condensation_i2c, []),
- I2I = ets:new(condensation_i2i, [bag]),
- CFun =
- fun(SC, N) ->
- lists:foreach(fun(V) -> true = ets:insert(V2I, {V,N}) end, SC),
- true = ets:insert(I2C, {N, SC}),
- N + 1
- end,
- lists:foldl(CFun, 1, SCs),
- Fun1 =
- fun({V1, V2}) ->
- I1 = ets:lookup_element(V2I, V1, 2),
- I2 = ets:lookup_element(V2I, V2, 2),
- I1 =:= I2 orelse ets:insert(I2I, {I1, I2})
- end,
- lists:foreach(Fun1, digraph:edges(G)),
- Fun3 =
- fun({I1, I2}, {Out, In}) ->
- SC1 = ets:lookup_element(I2C, I1, 2),
- SC2 = ets:lookup_element(I2C, I2, 2),
- {dict:append(SC1, SC2, Out), dict:append(SC2, SC1, In)}
- end,
- {OutDict, InDict} = ets:foldl(Fun3, {dict:new(), dict:new()}, I2I),
- [OutETS, InETS] =
+ SCCs = digraph_utils:strong_components(G),
+ %% Assign unique numbers to SCCs:
+ Ints = lists:seq(1, length(SCCs)),
+ IntToSCC = lists:zip(Ints, SCCs),
+ IntScc = sofs:relation(IntToSCC, [{int, scc}]),
+ %% Subsitute strong components for vertices in edges using the
+ %% unique numbers:
+ C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]),
+ I2V = sofs:relative_product(IntScc, C2V), % [{v, int}]
+ Es = sofs:relation(digraph:edges(G), [{v, v}]),
+ R1 = sofs:relative_product(I2V, Es),
+ R2 = sofs:relative_product(I2V, sofs:converse(R1)),
+ %% Create in- and out-neighbours:
+ In = sofs:relation_to_family(sofs:strict_relation(R2)),
+ R3 = sofs:converse(R2),
+ Out = sofs:relation_to_family(sofs:strict_relation(R3)),
+ [OutETS, InETS, MapsETS] =
[ets:new(Name,[{read_concurrency, true}]) ||
- Name <- [callgraph_deps_out, callgraph_deps_in]],
- ets:insert(OutETS, dict:to_list(OutDict)),
- ets:insert(InETS, dict:to_list(InDict)),
- ets:delete(V2I),
- ets:delete(I2C),
- ets:delete(I2I),
- {{'e', OutETS, InETS}, SCs}.
+ Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]],
+ ets:insert(OutETS, sofs:to_external(Out)),
+ ets:insert(InETS, sofs:to_external(In)),
+ %% Create mappings from SCCs to unique integers, and the inverse:
+ ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)),
+ ets:insert(MapsETS, IntToSCC),
+ {{'e', OutETS, InETS, MapsETS}, SCCs}.
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index fc56693ea3..e8c1613a33 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -637,8 +637,8 @@ cl_loop(State, LogCache) ->
{BackendPid, warnings, Warnings} ->
NewState = store_warnings(State, Warnings),
cl_loop(NewState, LogCache);
- {BackendPid, done, NewPlt, _NewDocPlt} ->
- return_value(State, NewPlt);
+ {BackendPid, done, NewMiniPlt, _NewDocPlt} ->
+ return_value(State, NewMiniPlt);
{BackendPid, ext_calls, ExtCalls} ->
cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache);
{BackendPid, ext_types, ExtTypes} ->
@@ -654,6 +654,7 @@ cl_loop(State, LogCache) ->
cl_error(State, Msg);
_Other ->
%% io:format("Received ~p\n", [_Other]),
+ %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored.
cl_loop(State, LogCache)
end.
@@ -699,10 +700,13 @@ return_value(State = #cl_state{erlang_mode = ErlangMode,
output_plt = OutputPlt,
plt_info = PltInfo,
stored_warnings = StoredWarnings},
- Plt) ->
+ MiniPlt) ->
case OutputPlt =:= none of
- true -> ok;
- false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo)
+ true ->
+ dialyzer_plt:delete(MiniPlt);
+ false ->
+ Plt = dialyzer_plt:restore_full_plt(MiniPlt),
+ dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo)
end,
UnknownWarnings = unknown_warnings(State),
RetValue =
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index 03cd9671af..a5bb4e209c 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -29,7 +29,9 @@
-module(dialyzer_codeserver).
-export([delete/1,
- finalize_contracts/3,
+ store_temp_contracts/4,
+ give_away/2,
+ finalize_contracts/1,
finalize_exported_types/2,
finalize_records/2,
get_contracts/1,
@@ -38,7 +40,9 @@
get_exports/1,
get_records/1,
get_next_core_label/1,
- get_temp_contracts/1,
+ get_temp_contracts/2,
+ contracts_modules/1,
+ store_contracts/4,
get_temp_exported_types/1,
get_temp_records/1,
insert/3,
@@ -48,6 +52,7 @@
is_exported/2,
lookup_mod_code/2,
lookup_mfa_code/2,
+ lookup_mfa_var_label/2,
lookup_mod_records/2,
lookup_mod_contracts/2,
lookup_mfa_contract/2,
@@ -56,21 +61,22 @@
set_next_core_label/2,
set_temp_records/2,
store_temp_records/3,
- store_temp_contracts/4]).
+ translate_fake_file/3]).
--export_type([codeserver/0, fun_meta_info/0]).
+-export_type([codeserver/0, fun_meta_info/0, contracts/0]).
-include("dialyzer.hrl").
%%--------------------------------------------------------------------
-type dict_ets() :: ets:tid().
+-type map_ets() :: ets:tid().
-type set_ets() :: ets:tid().
-type types() :: erl_types:type_table().
--type mod_records() :: dict:dict(module(), types()).
+-type mod_records() :: erl_types:mod_records().
--type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()).
+-type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}.
-type mod_contracts() :: dict:dict(module(), contracts()).
%% A property-list of data compiled from -compile and -dialyzer attributes.
@@ -81,16 +87,16 @@
-record(codeserver, {next_core_label = 0 :: label(),
code :: dict_ets(),
- exported_types :: set_ets() | 'undefined', % set(mfa())
- records :: dict_ets() | 'undefined',
- contracts :: dict_ets() | 'undefined',
- callbacks :: dict_ets() | 'undefined',
+ exported_types :: set_ets(), % set(mfa())
+ records :: map_ets(),
+ contracts :: map_ets(),
+ callbacks :: map_ets(),
fun_meta_info :: dict_ets(), % {mfa(), meta_info()}
exports :: 'clean' | set_ets(), % set(mfa())
temp_exported_types :: 'clean' | set_ets(), % set(mfa())
- temp_records :: 'clean' | dict_ets(),
- temp_contracts :: 'clean' | dict_ets(),
- temp_callbacks :: 'clean' | dict_ets()
+ temp_records :: 'clean' | map_ets(),
+ temp_contracts :: 'clean' | map_ets(),
+ temp_callbacks :: 'clean' | map_ets()
}).
-opaque codeserver() :: #codeserver{}.
@@ -104,7 +110,7 @@ ets_dict_find(Key, Table) ->
_:_ -> error
end.
-ets_dict_store(Key, Element, Table) ->
+ets_map_store(Key, Element, Table) ->
true = ets:insert(Table, {Key, Element}),
Table.
@@ -128,9 +134,6 @@ ets_set_to_set(Table) ->
Fold = fun({E}, Set) -> sets:add_element(E, Set) end,
ets:foldl(Fold, sets:new(), Table).
-ets_read_concurrent_table(Name) ->
- ets:new(Name, [{read_concurrency, true}]).
-
%%--------------------------------------------------------------------
-spec new() -> codeserver().
@@ -138,6 +141,13 @@ ets_read_concurrent_table(Name) ->
new() ->
CodeOptions = [compressed, public, {read_concurrency, true}],
Code = ets:new(dialyzer_codeserver_code, CodeOptions),
+ ReadOptions = [compressed, {read_concurrency, true}],
+ [Contracts, Callbacks, Records, ExportedTypes] =
+ [ets:new(Name, ReadOptions) ||
+ Name <- [dialyzer_codeserver_contracts,
+ dialyzer_codeserver_callbacks,
+ dialyzer_codeserver_records,
+ dialyzer_codeserver_exported_types]],
TempOptions = [public, {write_concurrency, true}],
[Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts,
TempCallbacks] =
@@ -150,6 +160,10 @@ new() ->
#codeserver{code = Code,
exports = Exports,
fun_meta_info = FunMetaInfo,
+ exported_types = ExportedTypes,
+ records = Records,
+ contracts = Contracts,
+ callbacks = Callbacks,
temp_exported_types = TempExportedTypes,
temp_records = TempRecords,
temp_contracts = TempContracts,
@@ -170,13 +184,15 @@ insert(Mod, ModCode, CS) ->
Exports = cerl:module_exports(ModCode),
Attrs = cerl:module_attrs(ModCode),
Defs = cerl:module_defs(ModCode),
+ {Files, SmallDefs} = compress_file_anno(Defs),
As = cerl:get_ann(ModCode),
Funs =
[{{Mod, cerl:fname_id(Var), cerl:fname_arity(Var)},
- Val} || Val = {Var, _Fun} <- Defs],
- Keys = [Key || {Key, _Value} <- Funs],
+ Val, {Var, cerl_trees:get_label(Fun)}} || Val = {Var, Fun} <- SmallDefs],
+ Keys = [Key || {Key, _Value, _Label} <- Funs],
ModEntry = {Mod, {Name, Exports, Attrs, Keys, As}},
- true = ets:insert(CS#codeserver.code, [ModEntry|Funs]),
+ ModFileEntry = {{mod, Mod}, Files},
+ true = ets:insert(CS#codeserver.code, [ModEntry, ModFileEntry|Funs]),
CS.
-spec get_temp_exported_types(codeserver()) -> sets:set(mfa()).
@@ -220,12 +236,12 @@ get_exports(#codeserver{exports = Exports}) ->
-spec finalize_exported_types(sets:set(mfa()), codeserver()) -> codeserver().
-finalize_exported_types(Set, CS) ->
- ExportedTypes = ets_read_concurrent_table(dialyzer_codeserver_exported_types),
+finalize_exported_types(Set,
+ #codeserver{exported_types = ExportedTypes,
+ temp_exported_types = TempETypes} = CS) ->
true = ets_set_insert_set(Set, ExportedTypes),
- TempExpTypes = CS#codeserver.temp_exported_types,
- true = ets:delete(TempExpTypes),
- CS#codeserver{exported_types = ExportedTypes, temp_exported_types = clean}.
+ true = ets:delete(TempETypes),
+ CS#codeserver{temp_exported_types = clean}.
-spec lookup_mod_code(atom(), codeserver()) -> cerl:c_module().
@@ -237,6 +253,11 @@ lookup_mod_code(Mod, CS) when is_atom(Mod) ->
lookup_mfa_code({_M, _F, _A} = MFA, CS) ->
table__lookup(CS#codeserver.code, MFA).
+-spec lookup_mfa_var_label(mfa(), codeserver()) -> {cerl:c_var(), label()}.
+
+lookup_mfa_var_label({_M, _F, _A} = MFA, CS) ->
+ ets:lookup_element(CS#codeserver.code, MFA, 3).
+
-spec get_next_core_label(codeserver()) -> label().
get_next_core_label(#codeserver{next_core_label = NCL}) ->
@@ -251,8 +272,8 @@ set_next_core_label(NCL, CS) ->
lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) ->
case ets_dict_find(Mod, RecDict) of
- error -> dict:new();
- {ok, Dict} -> Dict
+ error -> maps:new();
+ {ok, Map} -> Map
end.
-spec get_records(codeserver()) -> mod_records().
@@ -262,11 +283,11 @@ get_records(#codeserver{records = RecDict}) ->
-spec store_temp_records(module(), types(), codeserver()) -> codeserver().
-store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS)
+store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS)
when is_atom(Mod) ->
- case dict:size(Dict) =:= 0 of
+ case maps:size(Map) =:= 0 of
true -> CS;
- false -> CS#codeserver{temp_records = ets_dict_store(Mod, Dict, TempRecDict)}
+ false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)}
end.
-spec get_temp_records(codeserver()) -> mod_records().
@@ -284,20 +305,20 @@ set_temp_records(Dict, CS) ->
-spec finalize_records(mod_records(), codeserver()) -> codeserver().
-finalize_records(Dict, CS) ->
- true = ets:delete(CS#codeserver.temp_records),
- Records = ets_read_concurrent_table(dialyzer_codeserver_records),
+finalize_records(Dict, #codeserver{temp_records = TmpRecords,
+ records = Records} = CS) ->
+ true = ets:delete(TmpRecords),
true = ets_dict_store_dict(Dict, Records),
- CS#codeserver{records = Records, temp_records = clean}.
+ CS#codeserver{temp_records = clean}.
-spec lookup_mod_contracts(atom(), codeserver()) -> contracts().
lookup_mod_contracts(Mod, #codeserver{contracts = ContDict})
when is_atom(Mod) ->
case ets_dict_find(Mod, ContDict) of
- error -> dict:new();
+ error -> maps:new();
{ok, Keys} ->
- dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
+ maps:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
end.
get_file_contract(Key, ContDict) ->
@@ -330,48 +351,69 @@ get_callbacks(#codeserver{callbacks = CallbDict}) ->
-spec store_temp_contracts(module(), contracts(), contracts(), codeserver()) ->
codeserver().
-store_temp_contracts(Mod, SpecDict, CallbackDict,
+store_temp_contracts(Mod, SpecMap, CallbackMap,
#codeserver{temp_contracts = Cn,
temp_callbacks = Cb} = CS)
when is_atom(Mod) ->
- CS1 =
- case dict:size(SpecDict) =:= 0 of
- true -> CS;
- false ->
- CS#codeserver{temp_contracts = ets_dict_store(Mod, SpecDict, Cn)}
- end,
- case dict:size(CallbackDict) =:= 0 of
- true -> CS1;
- false ->
- CS1#codeserver{temp_callbacks = ets_dict_store(Mod, CallbackDict, Cb)}
- end.
-
--spec get_temp_contracts(codeserver()) -> {mod_contracts(), mod_contracts()}.
+ CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)},
+ CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}.
-get_temp_contracts(#codeserver{temp_contracts = TempContDict,
- temp_callbacks = TempCallDict}) ->
- {ets_dict_to_dict(TempContDict), ets_dict_to_dict(TempCallDict)}.
+-spec contracts_modules(codeserver()) -> [module()].
--spec finalize_contracts(mod_contracts(), mod_contracts(), codeserver()) ->
- codeserver().
+contracts_modules(#codeserver{temp_contracts = TempContTable}) ->
+ ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]).
-finalize_contracts(SpecDict, CallbackDict, CS) ->
- Contracts = ets_read_concurrent_table(dialyzer_codeserver_contracts),
- Callbacks = ets_read_concurrent_table(dialyzer_codeserver_callbacks),
- Contracts = dict:fold(fun decompose_spec_dict/3, Contracts, SpecDict),
- Callbacks = dict:fold(fun decompose_cb_dict/3, Callbacks, CallbackDict),
- CS#codeserver{contracts = Contracts, callbacks = Callbacks,
- temp_contracts = clean, temp_callbacks = clean}.
+-spec store_contracts(module(), contracts(), contracts(), codeserver()) ->
+ codeserver().
-decompose_spec_dict(Mod, Dict, Table) ->
- Keys = dict:fetch_keys(Dict),
- true = ets:insert(Table, dict:to_list(Dict)),
- true = ets:insert(Table, {Mod, Keys}),
- Table.
+store_contracts(Mod, SpecMap, CallbackMap, CS) ->
+ #codeserver{contracts = SpecDict, callbacks = CallbackDict} = CS,
+ Keys = maps:keys(SpecMap),
+ true = ets:insert(SpecDict, maps:to_list(SpecMap)),
+ true = ets:insert(SpecDict, {Mod, Keys}),
+ true = ets:insert(CallbackDict, maps:to_list(CallbackMap)),
+ CS.
-decompose_cb_dict(_Mod, Dict, Table) ->
- true = ets:insert(Table, dict:to_list(Dict)),
- Table.
+-spec get_temp_contracts(module(), codeserver()) ->
+ {contracts(), contracts()}.
+
+get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict,
+ temp_callbacks = TempCallDict}) ->
+ [{Mod, Contracts}] = ets:lookup(TempContDict, Mod),
+ true = ets:delete(TempContDict, Mod),
+ [{Mod, Callbacks}] = ets:lookup(TempCallDict, Mod),
+ true = ets:delete(TempCallDict, Mod),
+ {Contracts, Callbacks}.
+
+-spec give_away(codeserver(), pid()) -> 'ok'.
+
+give_away(#codeserver{temp_records = TempRecords,
+ temp_contracts = TempContracts,
+ temp_callbacks = TempCallbacks,
+ records = Records,
+ contracts = Contracts,
+ callbacks = Callbacks}, Pid) ->
+ _ = [true = ets:give_away(Table, Pid, any) ||
+ Table <- [TempRecords, TempContracts, TempCallbacks,
+ Records, Contracts, Callbacks],
+ Table =/= clean],
+ ok.
+
+-spec finalize_contracts(codeserver()) -> codeserver().
+
+finalize_contracts(#codeserver{temp_contracts = TempContDict,
+ temp_callbacks = TempCallDict} = CS) ->
+ true = ets:delete(TempContDict),
+ true = ets:delete(TempCallDict),
+ CS#codeserver{temp_contracts = clean, temp_callbacks = clean}.
+
+-spec translate_fake_file(codeserver(), module(), file:filename()) ->
+ file:filename().
+
+translate_fake_file(#codeserver{code = Code}, Module, FakeFile) ->
+ Files = ets:lookup_element(Code, {mod, Module}, 2),
+ {FakeFile, File} = lists:keyfind(FakeFile, 1, Files),
+ File.
table__lookup(TablePid, M) when is_atom(M) ->
{Name, Exports, Attrs, Keys, As} = ets:lookup_element(TablePid, M, 2),
@@ -379,3 +421,25 @@ table__lookup(TablePid, M) when is_atom(M) ->
cerl:ann_c_module(As, Name, Exports, Attrs, Defs);
table__lookup(TablePid, MFA) ->
ets:lookup_element(TablePid, MFA, 2).
+
+compress_file_anno(Term) ->
+ {Files, SmallTerm} = compress_file_anno(Term, []),
+ {[{FakeFile, File} || {File, {file, FakeFile}} <- Files], SmallTerm}.
+
+compress_file_anno({file, F}, Fs) when is_list(F) ->
+ case lists:keyfind(F, 1, Fs) of
+ false ->
+ I = integer_to_list(length(Fs)),
+ FileI = {file, I},
+ NFs = [{F, FileI}|Fs],
+ {NFs, FileI};
+ {F, FileI} -> {Fs, FileI}
+ end;
+compress_file_anno(T, Fs) when is_tuple(T) ->
+ {NFs, NL} = compress_file_anno(tuple_to_list(T), Fs),
+ {NFs, list_to_tuple(NL)};
+compress_file_anno([E|L], Fs) ->
+ {Fs1, NE} = compress_file_anno(E, Fs),
+ {NFs, NL} = compress_file_anno(L, Fs1),
+ {NFs, [NE|NL]};
+compress_file_anno(T, Fs) -> {Fs, T}.
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 73b04b305b..f3fba68e84 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -31,7 +31,7 @@
get_contract_return/2,
%% get_contract_signature/1,
is_overloaded/1,
- process_contract_remote_types/1,
+ process_contract_remote_types/2,
store_tmp_contract/5]).
-export_type([file_contract/0, plt_contracts/0]).
@@ -146,14 +146,13 @@ sequence([], _Delimiter) -> "";
sequence([H], _Delimiter) -> H;
sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter).
--spec process_contract_remote_types(dialyzer_codeserver:codeserver()) ->
- dialyzer_codeserver:codeserver().
+-spec process_contract_remote_types(dialyzer_codeserver:codeserver(),
+ erl_types:mod_records()) ->
+ dialyzer_codeserver:codeserver().
-process_contract_remote_types(CodeServer) ->
- {TmpContractDict, TmpCallbackDict} =
- dialyzer_codeserver:get_temp_contracts(CodeServer),
+process_contract_remote_types(CodeServer, RecordDict) ->
+ Mods = dialyzer_codeserver:contracts_modules(CodeServer),
ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer),
- RecordDict = dialyzer_codeserver:get_records(CodeServer),
ContractFun =
fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) ->
#tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract,
@@ -165,20 +164,21 @@ process_contract_remote_types(CodeServer) ->
{{MFA, {File, Contract, Xtra}}, C2}
end,
ModuleFun =
- fun({ModuleName, ContractDict}, C3) ->
- {NewContractList, C4} =
- lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)),
- {{ModuleName, dict:from_list(NewContractList)}, C4}
+ fun(ModuleName) ->
+ Cache = erl_types:cache__new(),
+ {ContractMap, CallbackMap} =
+ dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer),
+ {NewContractList, Cache1} =
+ lists:mapfoldl(ContractFun, Cache, maps:to_list(ContractMap)),
+ {NewCallbackList, _NewCache} =
+ lists:mapfoldl(ContractFun, Cache1, maps:to_list(CallbackMap)),
+ dialyzer_codeserver:store_contracts(ModuleName,
+ maps:from_list(NewContractList),
+ maps:from_list(NewCallbackList),
+ CodeServer)
end,
- Cache = erl_types:cache__new(),
- {NewContractList, C5} =
- lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)),
- {NewCallbackList, _C6} =
- lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)),
- NewContractDict = dict:from_list(NewContractList),
- NewCallbackDict = dict:from_list(NewCallbackList),
- dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict,
- CodeServer).
+ lists:foreach(ModuleFun, Mods),
+ dialyzer_codeserver:finalize_contracts(CodeServer).
-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]).
@@ -397,7 +397,7 @@ solve_constraints(Contract, Call, Constraints) ->
%% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]),
%% erl_types:t_assign_variables_to_subtype(Contract, Inf).
--type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()).
+-type contracts() :: dialyzer_codeserver:contracts().
%% Checks the contracts for functions that are not implemented
-spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) ->
@@ -407,12 +407,12 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) ->
AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity}
|| {Label, Arity} <- AllFuns0],
AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1],
- AllContractMFAs = dict:fetch_keys(Contracts),
+ AllContractMFAs = maps:keys(Contracts),
ErrorContractMFAs = AllContractMFAs -- AllFuns2,
[warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs].
warn_spec_missing_fun({M, F, A} = MFA, Contracts) ->
- {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts),
+ {{File, Line}, _Contract, _Xtra} = maps:get(MFA, Contracts),
WarningInfo = {File, Line, MFA},
{?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}.
@@ -445,11 +445,11 @@ insert_constraints([], Map) -> Map.
-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) ->
contracts().
-store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) ->
+store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) ->
%% io:format("contract from form: ~p\n", [TypeSpec]),
TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine),
%% io:format("contract: ~p\n", [TmpContract]),
- dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict).
+ maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap).
contract_from_form(Forms, MFA, RecDict, FileLine) ->
{CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []),
@@ -677,7 +677,7 @@ get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) ->
get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) ->
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer),
- Contracts2 = dict:to_list(Contracts1),
+ Contracts2 = maps:to_list(Contracts1),
Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer),
NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc),
get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc);
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 639ed426df..ce292e1140 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -529,7 +529,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
case is_race_analysis_enabled(State) of
true ->
Ann = cerl:get_ann(Tree),
- File = get_file(Ann),
+ File = get_file(Ann, State),
Line = abs(get_line(Ann)),
dialyzer_races:store_race_call(Fun, ArgTypes, Args,
{File, Line}, State);
@@ -3090,7 +3090,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
Ann = cerl:get_ann(Tree),
case Force of
true ->
- WarningInfo = {get_file(Ann),
+ WarningInfo = {get_file(Ann, State),
abs(get_line(Ann)),
State#state.curr_fun},
Warn = {Tag, WarningInfo, Msg},
@@ -3100,7 +3100,9 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
case is_compiler_generated(Ann) of
true -> State;
false ->
- WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun},
+ WarningInfo = {get_file(Ann, State),
+ get_line(Ann),
+ State#state.curr_fun},
Warn = {Tag, WarningInfo, Msg},
case Tag of
?WARN_CONTRACT_RANGE -> ok;
@@ -3499,6 +3501,12 @@ state__put_races(Races, State) ->
state__records_only(#state{records = Records}) ->
#state{records = Records}.
+-spec state__translate_file(file:filename(), state()) -> file:filename().
+
+state__translate_file(FakeFile, State) ->
+ #state{codeserver = CodeServer, module = Module} = State,
+ dialyzer_codeserver:translate_fake_file(CodeServer, Module, FakeFile).
+
%%% ===========================================================================
%%%
%%% Races
@@ -3570,9 +3578,11 @@ get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([]) -> [];
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file([], _State) -> [];
+get_file([{file, FakeFile}|_], State) ->
+ state__translate_file(FakeFile, State);
+get_file([_|Tail], State) ->
+ get_file(Tail, State).
is_compiler_generated(Ann) ->
lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1).
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index 4caf64d007..1701aff2f2 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -505,8 +505,9 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt,
end,
ExplanationPid = spawn_link(Fun),
gui_loop(State#gui_state{expl_pid = ExplanationPid});
- {BackendPid, done, _NewPlt, NewDocPlt} ->
+ {BackendPid, done, NewMiniPlt, NewDocPlt} ->
message(State, "Analysis done"),
+ dialyzer_plt:delete(NewMiniPlt),
config_gui_stop(State),
gui_loop(State#gui_state{doc_plt = NewDocPlt});
{'EXIT', BackendPid, {error, Reason}} ->
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index cf2f0e919e..0eda73a208 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -58,7 +58,9 @@
get_specs/4,
to_file/4,
get_mini_plt/1,
- restore_full_plt/2
+ restore_full_plt/1,
+ delete/1,
+ give_away/2
]).
%% Debug utilities
@@ -82,14 +84,16 @@
%%----------------------------------------------------------------------
-record(plt, {info = table_new() :: dict:dict(),
- types = table_new() :: dict:dict(),
+ types = table_new() :: erl_types:mod_records(),
contracts = table_new() :: dict:dict(),
callbacks = table_new() :: dict:dict(),
exported_types = sets:new() :: sets:set()}).
-record(mini_plt, {info :: ets:tid(),
+ types :: ets:tid(),
contracts :: ets:tid(),
- callbacks :: ets:tid()
+ callbacks :: ets:tid(),
+ exported_types :: ets:tid()
}).
-opaque plt() :: #plt{} | #mini_plt{}.
@@ -130,6 +134,10 @@ delete_module(#plt{info = Info, types = Types,
-spec delete_list(plt(), [mfa() | integer()]) -> plt().
+delete_list(#mini_plt{info = Info,
+ contracts = Contracts}=Plt, List) ->
+ Plt#mini_plt{info = ets_table_delete_list(Info, List),
+ contracts = ets_table_delete_list(Contracts, List)};
delete_list(#plt{info = Info, types = Types,
contracts = Contracts,
callbacks = Callbacks,
@@ -183,7 +191,7 @@ lookup(Plt, Label) when is_integer(Label) ->
lookup_1(#mini_plt{info = Info}, MFAorLabel) ->
ets_table_lookup(Info, MFAorLabel).
--spec insert_types(plt(), dict:dict()) -> plt().
+-spec insert_types(plt(), erl_types:mod_records()) -> plt().
insert_types(PLT, Rec) ->
PLT#plt{types = Rec}.
@@ -193,7 +201,7 @@ insert_types(PLT, Rec) ->
insert_exported_types(PLT, Set) ->
PLT#plt{exported_types = Set}.
--spec get_types(plt()) -> dict:dict().
+-spec get_types(plt()) -> erl_types:mod_records().
get_types(#plt{types = Types}) ->
Types.
@@ -253,8 +261,10 @@ from_file(FileName, ReturnInfo) ->
Msg = io_lib:format("Old PLT file ~s\n", [FileName]),
plt_error(Msg);
ok ->
+ Types = [{Mod, maps:from_list(dict:to_list(Types))} ||
+ {Mod, Types} <- dict:to_list(Rec#file_plt.types)],
Plt = #plt{info = Rec#file_plt.info,
- types = Rec#file_plt.types,
+ types = dict:from_list(Types),
contracts = Rec#file_plt.contracts,
callbacks = Rec#file_plt.callbacks,
exported_types = Rec#file_plt.exported_types},
@@ -371,12 +381,14 @@ to_file(FileName,
end,
OldModDeps, ModDeps),
ImplMd5 = compute_implementation_md5(),
+ FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} ||
+ {Mod, MTypes} <- dict:to_list(Types)]),
Record = #file_plt{version = ?VSN,
file_md5_list = MD5,
info = Info,
contracts = Contracts,
callbacks = Callbacks,
- types = Types,
+ types = FileTypes,
exported_types = ExpTypes,
mod_deps = NewModDeps,
implementation_md5 = ImplMd5},
@@ -510,32 +522,100 @@ init_md5_list_1(Md5List, [], Acc) ->
-spec get_mini_plt(plt()) -> plt().
-get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks}) ->
- [ETSInfo, ETSContracts, ETSCallbacks] =
- [ets:new(Name, [public]) || Name <- [plt_info, plt_contracts, plt_callbacks]],
+get_mini_plt(#plt{info = Info,
+ types = Types,
+ contracts = Contracts,
+ callbacks = Callbacks,
+ exported_types = ExpTypes}) ->
+ [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] =
+ [ets:new(Name, [public]) ||
+ Name <- [plt_info, plt_types, plt_contracts, plt_callbacks,
+ plt_exported_types]],
CallbackList = dict:to_list(Callbacks),
CallbacksByModule =
[{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} ||
M <- lists:usort([M || {{M,_,_},_} <- CallbackList])],
- [true, true] =
+ [true, true, true] =
[ets:insert(ETS, dict:to_list(Data)) ||
- {ETS, Data} <- [{ETSInfo, Info}, {ETSContracts, Contracts}]],
+ {ETS, Data} <- [{ETSInfo, Info},
+ {ETSTypes, Types},
+ {ETSContracts, Contracts}]],
true = ets:insert(ETSCallbacks, CallbacksByModule),
- #mini_plt{info = ETSInfo, contracts = ETSContracts, callbacks = ETSCallbacks};
+ true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]),
+ #mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes};
get_mini_plt(undefined) ->
undefined.
--spec restore_full_plt(plt(), plt()) -> plt().
-
-restore_full_plt(#mini_plt{info = ETSInfo, contracts = ETSContracts}, Plt) ->
- Info = dict:from_list(ets:tab2list(ETSInfo)),
- Contracts = dict:from_list(ets:tab2list(ETSContracts)),
- ets:delete(ETSContracts),
- ets:delete(ETSInfo),
- Plt#plt{info = Info, contracts = Contracts};
-restore_full_plt(undefined, undefined) ->
+-spec restore_full_plt(plt()) -> plt().
+
+restore_full_plt(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes} = MiniPlt) ->
+ Info = dict:from_list(tab2list(ETSInfo)),
+ Contracts = dict:from_list(tab2list(ETSContracts)),
+ Types = dict:from_list(tab2list(ETSTypes)),
+ Callbacks =
+ dict:from_list([Cb || {_M, Cbs} <- tab2list(ETSCallbacks), Cb <- Cbs]),
+ ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]),
+ ok = delete(MiniPlt),
+ #plt{info = Info,
+ types = Types,
+ contracts = Contracts,
+ callbacks = Callbacks,
+ exported_types = ExpTypes};
+restore_full_plt(undefined) ->
undefined.
+-spec delete(plt()) -> 'ok'.
+
+delete(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes}) ->
+ true = ets:delete(ETSContracts),
+ true = ets:delete(ETSTypes),
+ true = ets:delete(ETSInfo),
+ true = ets:delete(ETSCallbacks),
+ true = ets:delete(ETSExpTypes),
+ ok.
+
+-spec give_away(plt(), pid()) -> 'ok'.
+
+give_away(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes},
+ Pid) ->
+ true = ets:give_away(ETSContracts, Pid, any),
+ true = ets:give_away(ETSTypes, Pid, any),
+ true = ets:give_away(ETSInfo, Pid, any),
+ true = ets:give_away(ETSCallbacks, Pid, any),
+ true = ets:give_away(ETSExpTypes, Pid, any),
+ ok.
+
+%% Somewhat slower than ets:tab2list(), but uses less memory.
+tab2list(T) ->
+ tab2list(ets:first(T), T, []).
+
+tab2list('$end_of_table', T, A) ->
+ case ets:first(T) of % no safe_fixtable()...
+ '$end_of_table' -> A;
+ Key -> tab2list(Key, T, A)
+ end;
+tab2list(Key, T, A) ->
+ Vs = ets:lookup(T, Key),
+ Key1 = ets:next(T, Key),
+ ets:delete(T, Key),
+ tab2list(Key1, T, Vs ++ A).
+
%%---------------------------------------------------------------------------
%% Edoc
@@ -607,6 +687,12 @@ table_delete_module1(Plt, Mod) ->
table_delete_module2(Plt, Mod) ->
dict:filter(fun(M, _Val) -> M =/= Mod end, Plt).
+ets_table_delete_list(Tab, [H|T]) ->
+ ets:delete(Tab, H),
+ ets_table_delete_list(Tab, T);
+ets_table_delete_list(Tab, []) ->
+ Tab.
+
table_delete_list(Plt, [H|T]) ->
table_delete_list(dict:erase(H, Plt), T);
table_delete_list(Plt, []) ->
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 987da3aecf..0e44a5223f 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -96,7 +96,7 @@ analyze_callgraph(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent) ->
NewState =
init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
TimingServer, Solvers, Parent),
- dialyzer_plt:restore_full_plt(NewState#st.plt, Plt).
+ NewState#st.plt.
%%--------------------------------------------------------------------
@@ -111,6 +111,7 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
get_refined_success_typings(SCCs, #st{callgraph = Callgraph,
timing_server = TimingServer} = State) ->
+ erlang:garbage_collect(),
case find_succ_typings(SCCs, State) of
{fixpoint, State1} -> State1;
{not_fixpoint, NotFixpoint1, State1} ->
@@ -155,8 +156,8 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver,
?timing(TimingServer, "warning",
get_warnings_from_modules(Mods, InitState, MiniDocPlt)),
{postprocess_warnings(CWarns ++ ModWarns, Codeserver),
- dialyzer_plt:restore_full_plt(MiniPlt, Plt),
- dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}.
+ MiniPlt,
+ dialyzer_plt:restore_full_plt(MiniDocPlt)}.
get_warnings_from_modules(Mods, State, DocPlt) ->
#st{callgraph = Callgraph, codeserver = Codeserver,
@@ -174,10 +175,10 @@ collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) ->
%% Check if there are contracts for functions that do not exist
Warnings1 =
dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph),
+ Attrs = cerl:module_attrs(ModCode),
{Warnings2, FunTypes} =
dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver,
Records),
- Attrs = cerl:module_attrs(ModCode),
Warnings3 =
dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver),
DocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt),
@@ -262,7 +263,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) ->
NewFunTypes =
dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records),
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer),
- Contracts = orddict:from_list(dict:to_list(Contracts1)),
+ Contracts = orddict:from_list(maps:to_list(Contracts1)),
FindOpaques = find_opaques_fun(Records),
DecoratedFunTypes =
decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques),
@@ -348,21 +349,25 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph,
-spec find_succ_types_for_scc(scc(), typesig_init_data()) -> [mfa_or_funlbl()].
-find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) ->
- SCC_Info = [{MFA,
- dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
- dialyzer_codeserver:lookup_mod_records(M, Codeserver)}
- || {M, _, _} = MFA <- SCC],
+find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) ->
+ SCC = [MFA || {_, _, _} = MFA <- SCC0],
Contracts1 = [{MFA, dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver)}
- || {_, _, _} = MFA <- SCC],
+ || MFA <- SCC],
Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1],
Contracts3 = orddict:from_list(Contracts2),
Label = dialyzer_codeserver:get_next_core_label(Codeserver),
- AllFuns = collect_fun_info([Fun || {_MFA, {_Var, Fun}, _Rec} <- SCC_Info]),
+ AllFuns = lists:append(
+ [begin
+ {_Var, Fun} =
+ dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
+ collect_fun_info([Fun])
+ end || MFA <- SCC]),
+ erlang:garbage_collect(),
PropTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt),
%% Assume that the PLT contains the current propagated types
- FunTypes = dialyzer_typesig:analyze_scc(SCC_Info, Label, Callgraph,
- Plt, PropTypes, Solvers),
+ FunTypes = dialyzer_typesig:analyze_scc(SCC, Label, Callgraph,
+ Codeserver, Plt, PropTypes,
+ Solvers),
AllFunSet = sets:from_list([X || {X, _} <- AllFuns]),
FilteredFunTypes =
dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes),
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index 1787b66192..a9ebac6c8b 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -29,7 +29,7 @@
-module(dialyzer_typesig).
--export([analyze_scc/6]).
+-export([analyze_scc/7]).
-export([get_safe_underapprox/2]).
%%-import(helper, %% 'helper' could be any module doing sanity checks...
@@ -101,10 +101,9 @@
-type types() :: erl_types:type_table().
--type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}].
-type typesig_funmap() :: #{type_var() => type_var()}.
--type prop_types() :: dict:dict(label(), types()).
+-type prop_types() :: dict:dict(label(), erl_types:erl_type()).
-record(state, {callgraph :: dialyzer_callgraph:callgraph()
| 'undefined',
@@ -121,7 +120,7 @@
plt :: dialyzer_plt:plt()
| 'undefined',
prop_types = dict:new() :: prop_types(),
- records = dict:new() :: types(),
+ records = maps:new() :: types(),
scc = [] :: ordsets:ordset(type_var()),
mfas :: [mfa()],
solvers = [] :: [solver()]
@@ -160,11 +159,10 @@
%%-----------------------------------------------------------------------------
%% Analysis of strongly connected components.
%%
-%% analyze_scc(SCC, NextLabel, CallGraph, PLT, PropTypes, Solvers) -> FunTypes
+%% analyze_scc(SCC, NextLabel, CallGraph, CodeServer,
+%% PLT, PropTypes, Solvers) -> FunTypes
%%
-%% SCC - [{MFA, Def, Records}]
-%% where Def = {Var, Fun} as in the Core Erlang module definitions.
-%% Records = dict(RecName, {Arity, [{FieldName, FieldType}]})
+%% SCC - [{MFA}]
%% NextLabel - An integer that is higher than any label in the code.
%% CallGraph - A callgraph as produced by dialyzer_callgraph.erl
%% Note: The callgraph must have been built with all the
@@ -176,28 +174,27 @@
%% Solvers - User specified solvers.
%%-----------------------------------------------------------------------------
--spec analyze_scc(typesig_scc(), label(),
+-spec analyze_scc([mfa()], label(),
dialyzer_callgraph:callgraph(),
+ dialyzer_codeserver:codeserver(),
dialyzer_plt:plt(), prop_types(), [solver()]) -> prop_types().
-analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) ->
+analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) ->
Solvers = solvers(Solvers0),
- assert_format_of_scc(SCC),
- State1 = new_state(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers),
- DefSet = add_def_list([Var || {_MFA, {Var, _Fun}, _Rec} <- SCC], sets:new()),
- State2 = traverse_scc(SCC, DefSet, State1),
+ State1 = new_state(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes,
+ Solvers),
+ DefSet = add_def_list(maps:values(State1#state.name_map), sets:new()),
+ ModRecs = [{M, dialyzer_codeserver:lookup_mod_records(M, CServer)} ||
+ M <- lists:usort([M || {M, _, _} <- SCC])],
+ State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1),
State3 = state__finalize(State2),
+ erlang:garbage_collect(),
Funs = state__scc(State3),
pp_constrs_scc(Funs, State3),
constraints_to_dot_scc(Funs, State3),
T = solve(Funs, State3),
dict:from_list(maps:to_list(T)).
-assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) ->
- assert_format_of_scc(Left);
-assert_format_of_scc([]) ->
- ok.
-
solvers([]) -> [v2];
solvers(Solvers) -> Solvers.
@@ -207,12 +204,14 @@ solvers(Solvers) -> Solvers.
%%
%% ============================================================================
-traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) ->
+traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) ->
+ Def = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
+ {M, Rec} = lists:keyfind(M, 1, ModRecs),
TmpState1 = state__set_rec_dict(AccState, Rec),
DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)),
{NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1),
- traverse_scc(Left, DefSet, NewAccState);
-traverse_scc([], _DefSet, AccState) ->
+ traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState);
+traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) ->
AccState.
traverse(Tree, DefinedVars, State) ->
@@ -2702,11 +2701,14 @@ pp_map(_S, _Map) ->
%%
%% ============================================================================
-new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) ->
- List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0],
+new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) ->
+ List_SCC =
+ [begin
+ {Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer),
+ {{MFA, Var}, t_var(Label)}
+ end || MFA <- MFAs],
+ {List, SCC} = lists:unzip(List_SCC),
NameMap = maps:from_list(List),
- MFAs = [MFA || {MFA, _Var} <- List],
- SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0],
SelfRec =
case SCC of
[OneF] ->
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 1f2d3e3aaa..e71a953279 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -202,7 +202,7 @@ get_core_from_abstract_code(AbstrCode, Opts) ->
get_record_and_type_info(AbstractCode) ->
Module = get_module(AbstractCode),
- get_record_and_type_info(AbstractCode, Module, dict:new()).
+ get_record_and_type_info(AbstractCode, Module, maps:new()).
-spec get_record_and_type_info(abstract_code(), module(), type_table()) ->
{'ok', type_table()} | {'error', string()}.
@@ -215,7 +215,7 @@ get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left],
{ok, Fields} = get_record_fields(Fields0, RecDict),
Arity = length(Fields),
FN = {File, erl_anno:line(A)},
- NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict),
+ NewRecDict = maps:put({record, Name}, {FN, [{Arity,Fields}]}, RecDict),
get_record_and_type_info(Left, Module, NewRecDict, File);
get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}}
|Left], Module, RecDict, File) ->
@@ -223,7 +223,7 @@ get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}}
{ok, Fields} = get_record_fields(Fields0, RecDict),
Arity = length(Fields),
FN = {File, erl_anno:line(A)},
- NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict),
+ NewRecDict = maps:put({record, Name}, {FN, [{Arity, Fields}]}, RecDict),
get_record_and_type_info(Left, Module, NewRecDict, File);
get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left],
Module, RecDict, File)
@@ -263,9 +263,9 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN,
false ->
try erl_types:t_var_names(ArgForms) of
ArgNames ->
- dict:store({TypeOrOpaque, Name, Arity},
- {{Module, FN, TypeForm, ArgNames},
- erl_types:t_any()}, RecDict)
+ maps:put({TypeOrOpaque, Name, Arity},
+ {{Module, FN, TypeForm, ArgNames},
+ erl_types:t_any()}, RecDict)
catch
_:_ ->
throw({error, flat_format("Type declaration for ~w does not "
@@ -296,19 +296,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) ->
get_record_fields([], _RecDict, Acc) ->
lists:reverse(Acc).
--spec process_record_remote_types(codeserver()) -> codeserver().
+-spec process_record_remote_types(codeserver()) ->
+ {codeserver(), mod_records()}.
%% The field types are cached. Used during analysis when handling records.
process_record_remote_types(CServer) ->
TempRecords = dialyzer_codeserver:get_temp_records(CServer),
ExpTypes = dialyzer_codeserver:get_exported_types(CServer),
- Cache = erl_types:cache__new(),
- {TempRecords1, Cache1} =
- process_opaque_types0(TempRecords, ExpTypes, Cache),
+ TempRecords1 = process_opaque_types0(TempRecords, ExpTypes),
%% A cache (not the field type cache) is used for speeding things up a bit.
VarTable = erl_types:var_table__new(),
ModuleFun =
- fun({Module, Record}, C0) ->
+ fun({Module, Record}) ->
RecordFun =
fun({Key, Value}, C2) ->
case Key of
@@ -334,24 +333,27 @@ process_record_remote_types(CServer) ->
_Other -> {{Key, Value}, C2}
end
end,
- {RecordList, C1} =
- lists:mapfoldl(RecordFun, C0, dict:to_list(Record)),
- {{Module, dict:from_list(RecordList)}, C1}
+ Cache = erl_types:cache__new(),
+ {RecordList, _NewCache} =
+ lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)),
+ {Module, maps:from_list(RecordList)}
end,
- {NewRecordsList, C1} =
- lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)),
+ NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)),
NewRecords = dict:from_list(NewRecordsList),
- _C8 = check_record_fields(NewRecords, ExpTypes, C1),
- dialyzer_codeserver:finalize_records(NewRecords, CServer).
+ check_record_fields(NewRecords, ExpTypes),
+ {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}.
%% erl_types:t_from_form() substitutes the declaration of opaque types
%% for the expanded type in some cases. To make sure the initial type,
%% any(), is not used, the expansion is done twice.
%% XXX: Recursive opaque types are not handled well.
-process_opaque_types0(TempRecords0, TempExpTypes, Cache) ->
- {TempRecords1, NewCache} =
+process_opaque_types0(TempRecords0, TempExpTypes) ->
+ Cache = erl_types:cache__new(),
+ {TempRecords1, Cache1} =
process_opaque_types(TempRecords0, TempExpTypes, Cache),
- process_opaque_types(TempRecords1, TempExpTypes, NewCache).
+ {TempRecords, _NewCache} =
+ process_opaque_types(TempRecords1, TempExpTypes, Cache1),
+ TempRecords.
process_opaque_types(TempRecords, TempExpTypes, Cache) ->
VarTable = erl_types:var_table__new(),
@@ -371,8 +373,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) ->
end
end,
{RecordList, C1} =
- lists:mapfoldl(RecordFun, C0, dict:to_list(Record)),
- {{Module, dict:from_list(RecordList)}, C1}
+ lists:mapfoldl(RecordFun, C0, maps:to_list(Record)),
+ {{Module, maps:from_list(RecordList)}, C1}
%% dict:map(RecordFun, Record)
end,
{TempRecordList, NewCache} =
@@ -380,7 +382,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) ->
{dict:from_list(TempRecordList), NewCache}.
%% dict:map(ModuleFun, TempRecords).
-check_record_fields(Records, TempExpTypes, Cache) ->
+check_record_fields(Records, TempExpTypes) ->
+ Cache = erl_types:cache__new(),
VarTable = erl_types:var_table__new(),
CheckFun =
fun({Module, Element}, C0) ->
@@ -410,9 +413,10 @@ check_record_fields(Records, TempExpTypes, Cache) ->
msg_with_position(Fun, FileLine)
end
end,
- lists:foldl(ElemFun, C0, dict:to_list(Element))
+ lists:foldl(ElemFun, C0, maps:to_list(Element))
end,
- lists:foldl(CheckFun, Cache, dict:to_list(Records)).
+ _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)),
+ ok.
msg_with_position(Fun, FileLine) ->
try Fun()
@@ -435,17 +439,17 @@ merge_records(NewRecords, OldRecords) ->
%%
%% ============================================================================
--type spec_dict() :: dict:dict().
--type callback_dict() :: dict:dict().
+-type spec_map() :: dialyzer_codeserver:contracts().
+-type callback_map() :: dialyzer_codeserver:contracts().
-spec get_spec_info(module(), abstract_code(), type_table()) ->
- {'ok', spec_dict(), callback_dict()} | {'error', string()}.
+ {'ok', spec_map(), callback_map()} | {'error', string()}.
-get_spec_info(ModName, AbstractCode, RecordsDict) ->
+get_spec_info(ModName, AbstractCode, RecordsMap) ->
OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName),
OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0),
- get_spec_info(AbstractCode, dict:new(), dict:new(),
- RecordsDict, ModName, OptionalCallbacks, "nofile").
+ get_spec_info(AbstractCode, maps:new(), maps:new(),
+ RecordsMap, ModName, OptionalCallbacks, "nofile").
get_optional_callbacks(Abs, ModName) ->
[{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)].
@@ -463,7 +467,7 @@ get_optional_callbacks(Abs) ->
%% are erl_types:erl_type()
get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File)
+ SpecMap, CallbackMap, RecordsMap, ModName, OptCb, File)
when ((Contract =:= 'spec') or (Contract =:= 'callback')),
is_list(TypeSpec) ->
Ln = erl_anno:line(Anno),
@@ -472,24 +476,24 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
{F, A} -> {ModName, F, A}
end,
Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)],
- ActiveDict =
+ ActiveMap =
case Contract of
- spec -> SpecDict;
- callback -> CallbackDict
+ spec -> SpecMap;
+ callback -> CallbackMap
end,
- try dict:find(MFA, ActiveDict) of
+ try maps:find(MFA, ActiveMap) of
error ->
SpecData = {TypeSpec, Xtra},
- NewActiveDict =
+ NewActiveMap =
dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData,
- ActiveDict, RecordsDict),
- {NewSpecDict, NewCallbackDict} =
+ ActiveMap, RecordsMap),
+ {NewSpecMap, NewCallbackMap} =
case Contract of
- spec -> {NewActiveDict, CallbackDict};
- callback -> {SpecDict, NewActiveDict}
+ spec -> {NewActiveMap, CallbackMap};
+ callback -> {SpecMap, NewActiveMap}
end,
- get_spec_info(Left, NewSpecDict, NewCallbackDict,
- RecordsDict, ModName, OptCb, File);
+ get_spec_info(Left, NewSpecMap, NewCallbackMap,
+ RecordsMap, ModName, OptCb, File);
{ok, {{OtherFile, L}, _D}} ->
{Mod, Fun, Arity} = MFA,
Msg = flat_format(" Contract/callback for function ~w:~w/~w "
@@ -502,16 +506,16 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
[Ln, Error])}
end;
get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) ->
- get_spec_info(Left, SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, IncludeFile);
-get_spec_info([_Other|Left], SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, File) ->
- get_spec_info(Left, SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, File);
-get_spec_info([], SpecDict, CallbackDict,
- _RecordsDict, _ModName, _OptCb, _File) ->
- {ok, SpecDict, CallbackDict}.
+ SpecMap, CallbackMap, RecordsMap, ModName, OptCb, _File) ->
+ get_spec_info(Left, SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, IncludeFile);
+get_spec_info([_Other|Left], SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, File) ->
+ get_spec_info(Left, SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, File);
+get_spec_info([], SpecMap, CallbackMap,
+ _RecordsMap, _ModName, _OptCb, _File) ->
+ {ok, SpecMap, CallbackMap}.
-spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) ->
dialyzer_codeserver:fun_meta_info() | {'error', string()}.
@@ -707,7 +711,7 @@ format_errors([]) ->
-spec format_sig(erl_types:erl_type()) -> string().
format_sig(Type) ->
- format_sig(Type, dict:new()).
+ format_sig(Type, maps:new()).
-spec format_sig(erl_types:erl_type(), type_table()) -> string().
@@ -959,9 +963,7 @@ label(Tree) ->
-spec parallelism() -> integer().
parallelism() ->
- CPUs = erlang:system_info(logical_processors_available),
- Schedulers = erlang:system_info(schedulers),
- min(CPUs, Schedulers).
+ erlang:system_info(schedulers_online).
-spec family([{K,V}]) -> [{K,[V]}].
diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars
new file mode 100644
index 0000000000..2c1f8f8d17
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/chars
@@ -0,0 +1,4 @@
+
+chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok'
+chars.erl:32: Function t1/0 has no local return
+chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok'
diff --git a/lib/dialyzer/test/small_SUITE_data/src/anno.erl b/lib/dialyzer/test/small_SUITE_data/src/anno.erl
new file mode 100644
index 0000000000..70f1d42141
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/anno.erl
@@ -0,0 +1,18 @@
+-module(anno).
+
+%% OTP-14131
+
+-export([t1/0, t2/0, t3/0]).
+
+t1() ->
+ A = erl_parse:anno_from_term({attribute, 1, module, my_test}),
+ compile:forms([A], []).
+
+t2() ->
+ A = erl_parse:new_anno({attribute, 1, module, my_test}),
+ compile:forms([A], []).
+
+t3() ->
+ A = erl_parse:new_anno({attribute, 1, module, my_test}),
+ T = erl_parse:anno_to_term(A),
+ {attribute, 1, module, my_test} = T.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
new file mode 100644
index 0000000000..1e9c8ab6b9
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
@@ -0,0 +1,32 @@
+-module(chars).
+
+%% ERL-313
+
+-export([t/0]).
+-export([t1/0]).
+
+-record(r, {f :: $A .. $Z}).
+
+-type cs() :: $A..$Z | $a .. $z | $/.
+
+-spec t() -> $0-$0..$9-$0| $?.
+
+t() ->
+ c(#r{f = $z - 3}),
+ c($z - 3),
+ c($B).
+
+-spec c(cs()) -> $3-$0..$9-$0.
+
+c($A + 1) -> 2;
+c(C) ->
+ case C of
+ $z - 3 -> 3;
+ #r{f = $z - 3} -> 7
+ end.
+
+%% Display contract with character in warning:
+-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec
+f(_) -> ok.
+
+t1() -> f(#{b => $2}). % breaks the contract
diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile
index 21a0da926f..81fa8f187a 100644
--- a/lib/eldap/test/Makefile
+++ b/lib/eldap/test/Makefile
@@ -42,7 +42,7 @@ TARGET_FILES= \
SPEC_FILES = eldap.spec
-# COVER_FILE = eldap.cover
+COVER_FILE = eldap.cover
# ----------------------------------------------------
diff --git a/lib/eldap/test/eldap.cover b/lib/eldap/test/eldap.cover
new file mode 100644
index 0000000000..8c15956e72
--- /dev/null
+++ b/lib/eldap/test/eldap.cover
@@ -0,0 +1,3 @@
+{incl_app,eldap,details}.
+
+{excl_mods, eldap, ['ELDAPv3']}.
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 226a5d0f61..7edfbf65df 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -236,7 +236,8 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]).
+-export_type([erl_type/0, opaques/0, type_table/0, mod_records/0,
+ var_table/0, cache/0]).
%%-define(DEBUG, true).
@@ -379,8 +380,9 @@
-type type_value() :: {{module(), {file:name(), erl_anno:line()},
erl_parse:abstract_type(), ArgNames :: [atom()]},
erl_type()}.
--type type_table() :: dict:dict(record_key() | type_key(),
- record_value() | type_value()).
+-type type_table() :: #{record_key() | type_key() =>
+ record_value() | type_value()}.
+-type mod_records() :: dict:dict(module(), type_table()).
-opaque var_table() :: #{atom() => erl_type()}.
@@ -749,16 +751,16 @@ decorate_tuples_in_sets([], _L, _Opaques, Acc) ->
-spec t_opaque_from_records(type_table()) -> [erl_type()].
-t_opaque_from_records(RecDict) ->
- OpaqueRecDict =
- dict:filter(fun(Key, _Value) ->
+t_opaque_from_records(RecMap) ->
+ OpaqueRecMap =
+ maps:filter(fun(Key, _Value) ->
case Key of
{opaque, _Name, _Arity} -> true;
_ -> false
end
- end, RecDict),
- OpaqueTypeDict =
- dict:map(fun({opaque, Name, _Arity},
+ end, RecMap),
+ OpaqueTypeMap =
+ maps:map(fun({opaque, Name, _Arity},
{{Module, _FileLine, _Form, ArgNames}, _Type}) ->
%% Args = args_to_types(ArgNames),
%% List = lists:zip(ArgNames, Args),
@@ -767,8 +769,8 @@ t_opaque_from_records(RecDict) ->
Rep = t_any(), % not used for anything right now
Args = [t_any() || _ <- ArgNames],
t_opaque(Module, Name, Args, Rep)
- end, OpaqueRecDict),
- [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)].
+ end, OpaqueRecMap),
+ [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)].
%% Decompose opaque instances of type arg2 to structured types, in arg1
%% XXX: Same as t_unopaque
@@ -802,10 +804,6 @@ list_struct_from_opaque(Types, Opaques) ->
[t_struct_from_opaque(Type, Opaques) || Type <- Types].
%%-----------------------------------------------------------------------------
-
--type mod_records() :: dict:dict(module(), type_table()).
-
-%%-----------------------------------------------------------------------------
%% Unit type. Signals non termination.
%%
@@ -3067,88 +3065,91 @@ is_compat_args([A1|Args1], [A2|Args2]) ->
is_compat_args([], []) -> true;
is_compat_args(_, _) -> false.
-is_compat_arg(A1, A2) ->
- is_specialization(A1, A2) orelse is_specialization(A2, A1).
-
--spec is_specialization(erl_type(), erl_type()) -> boolean().
-
-%% Returns true if the first argument is a specialization of the
-%% second argument in the sense that every type is a specialization of
-%% any(). For example, {_,_} is a specialization of any(), but not of
-%% tuple(). Does not handle variables, but any() and unions (sort of).
-
-is_specialization(T, T) -> true;
-is_specialization(_, ?any) -> true;
-is_specialization(?any, _) -> false;
-is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
- (is_specialization(Domain1, Domain2) andalso
- is_specialization(Range1, Range2));
-is_specialization(?list(Contents1, Termination1, Size1),
- ?list(Contents2, Termination2, Size2)) ->
+-spec is_compat_arg(erl_type(), erl_type()) -> boolean().
+
+%% The intention is that 'true' is to be returned iff one of the
+%% arguments is a specialization of the other argument in the sense
+%% that every type is a specialization of any(). For example, {_,_} is
+%% a specialization of any(), but not of tuple(). Does not handle
+%% variables, but any() and unions (sort of). However, the
+%% implementation is more relaxed as any() is compatible to anything.
+
+is_compat_arg(T, T) -> true;
+is_compat_arg(_, ?any) -> true;
+is_compat_arg(?any, _) -> true;
+is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
+ (is_compat_arg(Domain1, Domain2) andalso
+ is_compat_arg(Range1, Range2));
+is_compat_arg(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2)) ->
(Size1 =:= Size2 andalso
- is_specialization(Contents1, Contents2) andalso
- is_specialization(Termination1, Termination2));
-is_specialization(?product(Types1), ?product(Types2)) ->
- specialization_list(Types1, Types2);
-is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
-is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
-is_specialization(?tuple(Elements1, Arity, _),
- ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
- specialization_list(Elements1, Elements2);
-is_specialization(?tuple_set([{Arity, List}]),
- ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
- specialization_list(sup_tuple_elements(List), Elements2);
-is_specialization(?tuple(Elements1, Arity, _),
- ?tuple_set([{Arity, List}])) when Arity =/= ?any ->
- specialization_list(Elements1, sup_tuple_elements(List));
-is_specialization(?tuple_set(List1), ?tuple_set(List2)) ->
+ is_compat_arg(Contents1, Contents2) andalso
+ is_compat_arg(Termination1, Termination2));
+is_compat_arg(?product(Types1), ?product(Types2)) ->
+ is_compat_list(Types1, Types2);
+is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) ->
+ (is_compat_list(Pairs1, Pairs2) andalso
+ is_compat_arg(DefK1, DefK2) andalso
+ is_compat_arg(DefV1, DefV2));
+is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
+is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(Elements1, Elements2);
+is_compat_arg(?tuple_set([{Arity, List}]),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(sup_tuple_elements(List), Elements2);
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple_set([{Arity, List}])) when Arity =/= ?any ->
+ is_compat_list(Elements1, sup_tuple_elements(List));
+is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) ->
try
- specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1],
- [sup_tuple_elements(T) || {_Arity, T} <- List2])
+ is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1],
+ [sup_tuple_elements(T) || {_Arity, T} <- List2])
catch _:_ -> false
end;
-is_specialization(?opaque(_) = T1, T2) ->
- is_specialization(t_opaque_structure(T1), T2);
-is_specialization(T1, ?opaque(_) = T2) ->
- is_specialization(T1, t_opaque_structure(T2));
-is_specialization(?union(List1)=T1, ?union(List2)=T2) ->
- case specialization_union2(T1, T2) of
- {yes, Type1, Type2} -> is_specialization(Type1, Type2);
- no -> specialization_list(List1, List2)
+is_compat_arg(?opaque(_) = T1, T2) ->
+ is_compat_arg(t_opaque_structure(T1), T2);
+is_compat_arg(T1, ?opaque(_) = T2) ->
+ is_compat_arg(T1, t_opaque_structure(T2));
+is_compat_arg(?union(List1)=T1, ?union(List2)=T2) ->
+ case is_compat_union2(T1, T2) of
+ {yes, Type1, Type2} -> is_compat_arg(Type1, Type2);
+ no -> is_compat_list(List1, List2)
end;
-is_specialization(?union(List), T2) ->
+is_compat_arg(?union(List), T2) ->
case unify_union(List) of
- {yes, Type} -> is_specialization(Type, T2);
+ {yes, Type} -> is_compat_arg(Type, T2);
no -> false
end;
-is_specialization(T1, ?union(List)) ->
+is_compat_arg(T1, ?union(List)) ->
case unify_union(List) of
- {yes, Type} -> is_specialization(T1, Type);
+ {yes, Type} -> is_compat_arg(T1, Type);
no -> false
end;
-is_specialization(?var(_), _) -> exit(error);
-is_specialization(_, ?var(_)) -> exit(error);
-is_specialization(?none, _) -> false;
-is_specialization(_, ?none) -> false;
-is_specialization(?unit, _) -> false;
-is_specialization(_, ?unit) -> false;
-is_specialization(#c{}, #c{}) -> false.
+is_compat_arg(?var(_), _) -> exit(error);
+is_compat_arg(_, ?var(_)) -> exit(error);
+is_compat_arg(?none, _) -> false;
+is_compat_arg(_, ?none) -> false;
+is_compat_arg(?unit, _) -> false;
+is_compat_arg(_, ?unit) -> false;
+is_compat_arg(#c{}, #c{}) -> false.
-specialization_list_list(LL1, LL2) ->
- length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2).
+is_compat_list_list(LL1, LL2) ->
+ length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2).
-specialization_list_list1([], []) -> true;
-specialization_list_list1([L1|LL1], [L2|LL2]) ->
- specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2).
+is_compat_list_list1([], []) -> true;
+is_compat_list_list1([L1|LL1], [L2|LL2]) ->
+ is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2).
-specialization_list(L1, L2) ->
- length(L1) =:= length(L2) andalso specialization_list1(L1, L2).
+is_compat_list(L1, L2) ->
+ length(L1) =:= length(L2) andalso is_compat_list1(L1, L2).
-specialization_list1([], []) -> true;
-specialization_list1([T1|L1], [T2|L2]) ->
- is_specialization(T1, T2) andalso specialization_list1(L1, L2).
+is_compat_list1([], []) -> true;
+is_compat_list1([T1|L1], [T2|L2]) ->
+ is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2).
-specialization_union2(?union(List1)=T1, ?union(List2)=T2) ->
+is_compat_union2(?union(List1)=T1, ?union(List2)=T2) ->
case {unify_union(List1), unify_union(List2)} of
{{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2};
{{yes, Type1}, no} -> {yes, Type1, T2};
@@ -4181,7 +4182,7 @@ t_map(Fun, T) ->
-spec t_to_string(erl_type()) -> string().
t_to_string(T) ->
- t_to_string(T, dict:new()).
+ t_to_string(T, maps:new()).
-spec t_to_string(erl_type(), type_table()) -> string().
@@ -4542,6 +4543,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) ->
{t_atom(Atom), L, C};
from_form({integer, _L, Int}, _S, _D, L, C) ->
{t_integer(Int), L, C};
+from_form({char, _L, Char}, _S, _D, L, C) ->
+ {t_integer(Char), L, C};
from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
@@ -5056,6 +5059,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]},
list_check_record_fields(Args, S, C);
check_record_fields({atom, _L, _}, _S, C) -> C;
check_record_fields({integer, _L, _}, _S, C) -> C;
+check_record_fields({char, _L, _}, _S, C) -> C;
check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C;
check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C;
check_record_fields({type, _L, tuple, any}, _S, C) -> C;
@@ -5157,6 +5161,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name);
t_form_to_string({atom, _L, Atom}) ->
io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... '
t_form_to_string({integer, _L, Int}) -> integer_to_list(Int);
+t_form_to_string({char, _L, Char}) -> integer_to_list(Char);
t_form_to_string({op, _L, _Op, _Arg} = Op) ->
case erl_eval:partial_eval(Op) of
{integer, _, _} = Int -> t_form_to_string(Int);
@@ -5239,7 +5244,7 @@ t_form_to_string({type, _L, union, Args}) ->
t_form_to_string({type, _L, Name, []} = T) ->
try
M = mod,
- D0 = dict:new(),
+ D0 = maps:new(),
MR = dict:from_list([{M, D0}]),
Site = {type, {M,Name,0}},
V = var_table__new(),
@@ -5303,8 +5308,8 @@ is_erl_type(_) -> false.
-spec lookup_record(atom(), type_table()) ->
'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
-lookup_record(Tag, RecDict) when is_atom(Tag) ->
- case dict:find({record, Tag}, RecDict) of
+lookup_record(Tag, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
{ok, {_FileLine, [{_Arity, Fields}]}} ->
{ok, Fields};
{ok, {_FileLine, List}} when is_list(List) ->
@@ -5318,18 +5323,18 @@ lookup_record(Tag, RecDict) when is_atom(Tag) ->
-spec lookup_record(atom(), arity(), type_table()) ->
'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
-lookup_record(Tag, Arity, RecDict) when is_atom(Tag) ->
- case dict:find({record, Tag}, RecDict) of
+lookup_record(Tag, Arity, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
{ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields};
{ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict);
error -> error
end.
-spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'.
-lookup_type(Name, Arity, RecDict) ->
- case dict:find({type, Name, Arity}, RecDict) of
+lookup_type(Name, Arity, Table) ->
+ case maps:find({type, Name, Arity}, Table) of
error ->
- case dict:find({opaque, Name, Arity}, RecDict) of
+ case maps:find({opaque, Name, Arity}, Table) of
error -> error;
{ok, Found} -> {opaque, Found}
end;
@@ -5339,8 +5344,8 @@ lookup_type(Name, Arity, RecDict) ->
-spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) ->
boolean().
-type_is_defined(TypeOrOpaque, Name, Arity, RecDict) ->
- dict:is_key({TypeOrOpaque, Name, Arity}, RecDict).
+type_is_defined(TypeOrOpaque, Name, Arity, Table) ->
+ maps:is_key({TypeOrOpaque, Name, Arity}, Table).
cannot_have_opaque(Type, TypeName, TypeNames) ->
t_is_none(Type) orelse is_recursive(TypeName, TypeNames).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl
new file mode 100644
index 0000000000..807c4b0d0d
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl
@@ -0,0 +1,217 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% File : basic_num_bif.erl
+%%% Description : Taken from the compiler test suite
+%%%-------------------------------------------------------------------
+-module(basic_num_bif).
+
+-export([test/0]).
+
+%% Tests optimization of the BIFs:
+%% abs/1
+%% float/1
+%% float_to_list/1
+%% integer_to_list/1
+%% list_to_float/1
+%% list_to_integer/1
+%% round/1
+%% trunc/1
+
+test() ->
+ Funs = [fun t_abs/0, fun t_float/0,
+ fun t_float_to_list/0, fun t_integer_to_list/0,
+ fun t_list_to_float_safe/0, fun t_list_to_float_risky/0,
+ fun t_list_to_integer/0, fun t_round/0, fun t_trunc/0],
+ lists:foreach(fun (F) -> ok = F() end, Funs).
+
+t_abs() ->
+ %% Floats.
+ 5.5 = abs(5.5),
+ 0.0 = abs(0.0),
+ 100.0 = abs(-100.0),
+ %% Integers.
+ 5 = abs(5),
+ 0 = abs(0),
+ 100 = abs(-100),
+ %% The largest smallnum. OTP-3190.
+ X = (1 bsl 27) - 1,
+ X = abs(X),
+ X = abs(X-1)+1,
+ X = abs(X+1)-1,
+ X = abs(-X),
+ X = abs(-X-1)-1,
+ X = abs(-X+1)+1,
+ %% Bignums.
+ BigNum = 13984792374983749,
+ BigNum = abs(BigNum),
+ BigNum = abs(-BigNum),
+ ok.
+
+t_float() ->
+ 0.0 = float(0),
+ 2.5 = float(2.5),
+ 0.0 = float(0.0),
+ -100.55 = float(-100.55),
+ 42.0 = float(42),
+ -100.0 = float(-100),
+ %% Bignums.
+ 4294967305.0 = float(4294967305),
+ -4294967305.0 = float(-4294967305),
+ %% Extremely big bignums.
+ Big = list_to_integer(lists:duplicate(2000, $1)),
+ {'EXIT', {badarg, _}} = (catch float(Big)),
+ ok.
+
+%% Tests float_to_list/1.
+
+t_float_to_list() ->
+ test_ftl("0.0e+0", 0.0),
+ test_ftl("2.5e+1", 25.0),
+ test_ftl("2.5e+0", 2.5),
+ test_ftl("2.5e-1", 0.25),
+ test_ftl("-3.5e+17", -350.0e15),
+ ok.
+
+test_ftl(Expect, Float) ->
+ %% No on the next line -- we want the line number from t_float_to_list.
+ Expect = remove_zeros(lists:reverse(float_to_list(Float)), []).
+
+%% Removes any non-significant zeros in a floating point number.
+%% Example: 2.500000e+01 -> 2.5e+1
+
+remove_zeros([$+, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$+, $e|Rest], [X|Result]);
+remove_zeros([$-, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$-, $e|Rest], [X|Result]);
+remove_zeros([$0, $.|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$., $0, $e|Result]);
+remove_zeros([$0|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$e|Result]);
+remove_zeros([Char|Rest], Result) ->
+ remove_zeros(Rest, [Char|Result]);
+remove_zeros([], Result) ->
+ Result.
+
+%% Tests integer_to_list/1.
+
+t_integer_to_list() ->
+ "0" = integer_to_list(0),
+ "42" = integer_to_list(42),
+ "-42" = integer_to_list(-42),
+ "-42" = integer_to_list(-42),
+ "32768" = integer_to_list(32768),
+ "268435455" = integer_to_list(268435455),
+ "-268435455" = integer_to_list(-268435455),
+ "123456932798748738738" = integer_to_list(123456932798748738738),
+ Big_List = lists:duplicate(2000, $1),
+ Big = list_to_integer(Big_List),
+ Big_List = integer_to_list(Big),
+ ok.
+
+%% Tests list_to_float/1.
+
+t_list_to_float_safe() ->
+ 0.0 = list_to_float("0.0"),
+ 0.0 = list_to_float("-0.0"),
+ 0.5 = list_to_float("0.5"),
+ -0.5 = list_to_float("-0.5"),
+ 100.0 = list_to_float("1.0e2"),
+ 127.5 = list_to_float("127.5"),
+ -199.5 = list_to_float("-199.5"),
+ ok.
+
+%% This might crash the emulator...
+%% (Known to crash the Unix version of Erlang 4.4.1)
+
+t_list_to_float_risky() ->
+ Many_Ones = lists:duplicate(25000, $1),
+ _ = list_to_float("2."++Many_Ones),
+ {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)),
+ ok.
+
+%% Tests list_to_integer/1.
+
+t_list_to_integer() ->
+ 0 = list_to_integer("0"),
+ 0 = list_to_integer("00"),
+ 0 = list_to_integer("-0"),
+ 1 = list_to_integer("1"),
+ -1 = list_to_integer("-1"),
+ 42 = list_to_integer("42"),
+ -12 = list_to_integer("-12"),
+ 32768 = list_to_integer("32768"),
+ 268435455 = list_to_integer("268435455"),
+ -268435455 = list_to_integer("-268435455"),
+ %% Bignums.
+ 123456932798748738738 = list_to_integer("123456932798748738738"),
+ _ = list_to_integer(lists:duplicate(2000, $1)),
+ ok.
+
+%% Tests round/1.
+
+t_round() ->
+ 0 = round(0.0),
+ 0 = round(0.4),
+ 1 = round(0.5),
+ 0 = round(-0.4),
+ -1 = round(-0.5),
+ 255 = round(255.3),
+ 256 = round(255.6),
+ -1033 = round(-1033.3),
+ -1034 = round(-1033.6),
+ %% OTP-3722:
+ X = (1 bsl 27) - 1,
+ MX = -X,
+ MXm1 = -X-1,
+ MXp1 = -X+1,
+ F = X + 0.0,
+ X = round(F),
+ X = round(F+1)-1,
+ X = round(F-1)+1,
+ MX = round(-F),
+ MXm1 = round(-F-1),
+ MXp1 = round(-F+1),
+ X = round(F+0.1),
+ X = round(F+1+0.1)-1,
+ X = round(F-1+0.1)+1,
+ MX = round(-F+0.1),
+ MXm1 = round(-F-1+0.1),
+ MXp1 = round(-F+1+0.1),
+ X = round(F-0.1),
+ X = round(F+1-0.1)-1,
+ X = round(F-1-0.1)+1,
+ MX = round(-F-0.1),
+ MXm1 = round(-F-1-0.1),
+ MXp1 = round(-F+1-0.1),
+ 0.5 = abs(round(F+0.5)-(F+0.5)),
+ 0.5 = abs(round(F-0.5)-(F-0.5)),
+ 0.5 = abs(round(-F-0.5)-(-F-0.5)),
+ 0.5 = abs(round(-F+0.5)-(-F+0.5)),
+ %% Bignums.
+ 4294967296 = round(4294967296.1),
+ 4294967297 = round(4294967296.9),
+ -4294967296 = -round(4294967296.1),
+ -4294967297 = -round(4294967296.9),
+ ok.
+
+t_trunc() ->
+ 0 = trunc(0.0),
+ 5 = trunc(5.3333),
+ -10 = trunc(-10.978987),
+ %% The largest smallnum, converted to float (OTP-3722):
+ X = (1 bsl 27) - 1,
+ F = X + 0.0,
+ %% io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n",
+ %% [X, X, binary_to_list(term_to_binary(X)),
+ %% F, F, binary_to_list(term_to_binary(F)),
+ %% trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]),
+ X = trunc(F),
+ X = trunc(F+1)-1,
+ X = trunc(F-1)+1,
+ X = -trunc(-F),
+ X = -trunc(-F-1)-1,
+ X = -trunc(-F+1)+1,
+ %% Bignums.
+ 4294967305 = trunc(4294967305.7),
+ -4294967305 = trunc(-4294967305.7),
+ ok.
diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl
index a5b3924aa8..b9adb660f2 100644
--- a/lib/hipe/test/hipe_SUITE.erl
+++ b/lib/hipe/test/hipe_SUITE.erl
@@ -16,7 +16,11 @@
%%
-module(hipe_SUITE).
--compile([export_all]).
+-export([all/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ app/0, app/1, appup/0, appup/1]).
+
-include_lib("common_test/include/ct.hrl").
all() ->
diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl
index 61952e81d7..86083fa02b 100644
--- a/lib/hipe/test/opt_verify_SUITE.erl
+++ b/lib/hipe/test/opt_verify_SUITE.erl
@@ -1,6 +1,9 @@
-module(opt_verify_SUITE).
--compile([export_all]).
+-export([all/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ call_elim/0, call_elim/1]).
all() ->
[call_elim].
@@ -23,23 +26,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-call_elim_test_file(Config, FileName, Option) ->
- PrivDir = test_server:lookup_config(priv_dir, Config),
- TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")),
- {ok, TestCase} = compile:file(FileName),
- {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]),
- {ok, Icode} = file:read_file(TempOut),
- ok = file:delete(TempOut),
- Icode.
-
-substring_count(Icode, Substring) ->
- substring_count(Icode, Substring, 0).
-substring_count(Icode, Substring, N) ->
- case string:str(Icode, Substring) of
- 0 -> N;
- I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
- end.
-
call_elim() ->
[{doc, "Test that the call elimination optimization pass is ok"}].
call_elim(Config) ->
@@ -60,3 +46,20 @@ call_elim(Config) ->
Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim),
3 = substring_count(binary:bin_to_list(Icode6), "is_key"),
ok.
+
+call_elim_test_file(Config, FileName, Option) ->
+ PrivDir = test_server:lookup_config(priv_dir, Config),
+ TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")),
+ {ok, TestCase} = compile:file(FileName),
+ {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]),
+ {ok, Icode} = file:read_file(TempOut),
+ ok = file:delete(TempOut),
+ Icode.
+
+substring_count(Icode, Substring) ->
+ substring_count(Icode, Substring, 0).
+substring_count(Icode, Substring, N) ->
+ case string:str(Icode, Substring) of
+ 0 -> N;
+ I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
+ end.
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 705afec022..4217b3c4fb 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -83,7 +83,7 @@
<title>HTTP DATA TYPES</title>
<p>Type definitions related to HTTP:</p>
- <p><c>method() = head | get | put | post | trace | options | delete</c></p>
+ <p><c>method() = head | get | put | post | trace | options | delete | patch</c></p>
<taglist>
<tag><c>request()</c></tag>
<item><p>= <c>{url(), headers()}</c></p>
diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index 91d87289a2..bd5f6df39e 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) ->
request(Method, Request, HttpOptions, Options, default_profile()).
request(Method,
+ {Url, Headers, ContentType, TupleBody},
+ HTTPOptions, Options, Profile)
+ when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete))
+ andalso (is_atom(Profile) orelse is_pid(Profile)) andalso
+ is_list(ContentType) andalso is_tuple(TupleBody)->
+ case check_body_gen(TupleBody) of
+ ok ->
+ do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile);
+ Error ->
+ Error
+ end;
+request(Method,
+ {Url, Headers, ContentType, Body},
+ HTTPOptions, Options, Profile)
+ when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete))
+ andalso (is_atom(Profile) orelse is_pid(Profile)) andalso
+ is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) ->
+ do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile);
+
+request(Method,
{Url, Headers},
HTTPOptions, Options, Profile)
when (Method =:= options) orelse
@@ -155,12 +175,6 @@ request(Method,
(Method =:= delete) orelse
(Method =:= trace) andalso
(is_atom(Profile) orelse is_pid(Profile)) ->
- ?hcrt("request", [{method, Method},
- {url, Url},
- {headers, Headers},
- {http_options, HTTPOptions},
- {options, Options},
- {profile, Profile}]),
case uri_parse(Url, Options) of
{error, Reason} ->
{error, Reason};
@@ -172,21 +186,9 @@ request(Method,
handle_request(Method, Url, ParsedUrl, Headers, [], [],
HTTPOptions, Options, Profile)
end
- end;
-
-request(Method,
- {Url, Headers, ContentType, Body},
- HTTPOptions, Options, Profile)
- when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse
- (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) ->
- ?hcrt("request", [{method, Method},
- {url, Url},
- {headers, Headers},
- {content_type, ContentType},
- {body, Body},
- {http_options, HTTPOptions},
- {options, Options},
- {profile, Profile}]),
+ end.
+
+do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) ->
case uri_parse(Url, Options) of
{error, Reason} ->
{error, Reason};
@@ -196,7 +198,6 @@ request(Method,
HTTPOptions, Options, Profile)
end.
-
%%--------------------------------------------------------------------------
%% cancel_request(RequestId) -> ok
%% cancel_request(RequestId, Profile) -> ok
@@ -209,7 +210,6 @@ cancel_request(RequestId) ->
cancel_request(RequestId, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]),
httpc_manager:cancel_request(RequestId, profile_name(Profile)).
@@ -232,7 +232,6 @@ cancel_request(RequestId, Profile)
set_options(Options) ->
set_options(Options, default_profile()).
set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("set options", [{options, Options}, {profile, Profile}]),
case validate_options(Options) of
{ok, Opts} ->
httpc_manager:set_options(Opts, profile_name(Profile));
@@ -272,7 +271,6 @@ get_options(all = _Options, Profile) ->
get_options(Options, Profile)
when (is_list(Options) andalso
(is_atom(Profile) orelse is_pid(Profile))) ->
- ?hcrt("get options", [{options, Options}, {profile, Profile}]),
case Options -- get_options() of
[] ->
try
@@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) ->
store_cookies(SetCookieHeaders, Url, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders},
- {url, Url},
- {profile, Profile}]),
try
begin
%% Since the Address part is not actually used
@@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) ->
cookie_header(Url, Opts, Profile)
when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) ->
- ?hcrt("cookie header", [{url, Url},
- {opts, Opts},
- {profile, Profile}]),
try
begin
httpc_manager:which_cookies(Url, Opts, profile_name(Profile))
@@ -398,7 +390,6 @@ which_sessions() ->
which_sessions(default_profile()).
which_sessions(Profile) ->
- ?hcrt("which sessions", [{profile, Profile}]),
try
begin
httpc_manager:which_sessions(profile_name(Profile))
@@ -419,7 +410,6 @@ info() ->
info(default_profile()).
info(Profile) ->
- ?hcrt("info", [{profile, Profile}]),
try
begin
httpc_manager:info(profile_name(Profile))
@@ -440,7 +430,6 @@ reset_cookies() ->
reset_cookies(default_profile()).
reset_cookies(Profile) ->
- ?hcrt("reset cookies", [{profile, Profile}]),
try
begin
httpc_manager:reset_cookies(profile_name(Profile))
@@ -458,7 +447,6 @@ reset_cookies(Profile) ->
%% same behavior as active once for sockets.
%%-------------------------------------------------------------------------
stream_next(Pid) ->
- ?hcrt("stream next", [{handler, Pid}]),
httpc_handler:stream_next(Pid).
@@ -466,7 +454,6 @@ stream_next(Pid) ->
%%% Behaviour callbacks
%%%========================================================================
start_standalone(PropList) ->
- ?hcrt("start standalone", [{proplist, PropList}]),
case proplists:get_value(profile, PropList) of
undefined ->
{error, no_profile};
@@ -477,14 +464,11 @@ start_standalone(PropList) ->
end.
start_service(Config) ->
- ?hcrt("start service", [{config, Config}]),
httpc_profile_sup:start_child(Config).
stop_service(Profile) when is_atom(Profile) ->
- ?hcrt("stop service", [{profile, Profile}]),
httpc_profile_sup:stop_child(Profile);
stop_service(Pid) when is_pid(Pid) ->
- ?hcrt("stop service", [{pid, Pid}]),
case service_info(Pid) of
{ok, [{profile, Profile}]} ->
stop_service(Profile);
@@ -510,7 +494,6 @@ service_info(Pid) ->
%%%========================================================================
%%% Internal functions
%%%========================================================================
-
handle_request(Method, Url,
{Scheme, UserInfo, Host, Port, Path, Query},
Headers0, ContentType, Body0,
@@ -521,9 +504,6 @@ handle_request(Method, Url,
try
begin
- ?hcrt("begin processing", [{started, Started},
- {new_headers, NewHeaders0}]),
-
{NewHeaders, Body} =
case Body0 of
{chunkify, ProcessBody, Acc}
@@ -575,16 +555,13 @@ handle_request(Method, Url,
{ok, RequestId} ->
handle_answer(RequestId, Sync, Options);
{error, Reason} ->
- ?hcrd("request failed", [{reason, Reason}]),
{error, Reason}
end
end
catch
error:{noproc, _} ->
- ?hcrv("noproc", [{profile, Profile}]),
{error, {not_started, Profile}};
throw:Error ->
- ?hcrv("throw", [{error, Error}]),
Error
end.
@@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) ->
handle_answer(RequestId, true, Options) ->
receive
{http, {RequestId, saved_to_file}} ->
- ?hcrt("received saved-to-file", [{request_id, RequestId}]),
{ok, saved_to_file};
{http, {RequestId, {_,_,_} = Result}} ->
- ?hcrt("received answer", [{request_id, RequestId},
- {result, Result}]),
return_answer(Options, Result);
{http, {RequestId, {error, Reason}}} ->
- ?hcrt("received error", [{request_id, RequestId},
- {reason, Reason}]),
{error, Reason}
end.
@@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) ->
child_name(Pid, [_ | Children]) ->
child_name(Pid, Children).
-%% d(F) ->
-%% d(F, []).
-
-%% d(F, A) ->
-%% d(get(dbg), F, A).
-
-%% d(true, F, A) ->
-%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]);
-%% d(_, _, _) ->
-%% ok.
-
host_address(Host, false) ->
Host;
host_address(Host, true) ->
string:strip(string:strip(Host, right, $]), left, $[).
+
+check_body_gen({Fun, _}) when is_function(Fun) ->
+ ok;
+check_body_gen({chunkify, Fun, _}) when is_function(Fun) ->
+ ok;
+check_body_gen(Gen) ->
+ {error, {bad_body_generator, Gen}}.
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 2e7df8e424..c99200777b 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -32,7 +32,6 @@
%% Internal Application API
-export([
start_link/4,
- %% connect_and_send/2,
send/2,
cancel/2,
stream_next/1,
@@ -165,14 +164,12 @@ info(Pid) ->
%%--------------------------------------------------------------------
%% Request should not be streamed
stream(BodyPart, #request{stream = none} = Request, _) ->
- ?hcrt("stream - none", []),
{false, BodyPart, Request};
%% Stream to caller
stream(BodyPart, #request{stream = Self} = Request, Code)
when ?IS_STREAMED(Code) andalso
((Self =:= self) orelse (Self =:= {self, once})) ->
- ?hcrt("stream - self", [{stream, Self}, {code, Code}]),
httpc_response:send(Request#request.from,
{Request#request.id, stream, BodyPart}),
{true, <<>>, Request};
@@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code)
%% We keep this for backward compatibillity...
stream(BodyPart, #request{stream = Filename} = Request, Code)
when ?IS_STREAMED(Code) andalso is_list(Filename) ->
- ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]),
case file:open(Filename, [write, raw, append, delayed_write]) of
{ok, Fd} ->
- ?hcrt("stream - file open ok", [{fd, Fd}]),
stream(BodyPart, Request#request{stream = Fd}, 200);
{error, Reason} ->
exit({stream_to_file_failed, Reason})
@@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code)
%% Stream to file
stream(BodyPart, #request{stream = Fd} = Request, Code)
when ?IS_STREAMED(Code) ->
- ?hcrt("stream to file", [{stream, Fd}, {code, Code}]),
case file:write(Fd, BodyPart) of
ok ->
{true, <<>>, Request};
@@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code)
end;
stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed
- ?hcrt("stream - ignore", [{request, Request}]),
{false, BodyPart, Request}.
@@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) ->
%% {stop, Reason, State} (terminate/2 is called)
%% Description: Handling call messages
%%--------------------------------------------------------------------
-handle_call(#request{address = Addr} = Request, _,
+handle_call(Request, From, State) ->
+ try do_handle_call(Request, From, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(Msg, State) ->
+ try do_handle_cast(Msg, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info(Info, State) ->
+ try do_handle_info(Info, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> _ (ignored by gen_server)
+%% Description: Shutdown the httpc_handler
+%%--------------------------------------------------------------------
+
+%% Init error there is no socket to be closed.
+terminate(normal,
+ #state{request = Request,
+ session = {send_failed, _} = Reason} = State) ->
+ maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ ok;
+
+terminate(normal,
+ #state{request = Request,
+ session = {connect_failed, _} = Reason} = State) ->
+ maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ ok;
+
+terminate(normal, #state{session = undefined}) ->
+ ok;
+
+%% Init error sending, no session information has been setup but
+%% there is a socket that needs closing.
+terminate(normal,
+ #state{session = #session{id = undefined} = Session}) ->
+ close_socket(Session);
+
+%% Socket closed remotely
+terminate(normal,
+ #state{session = #session{socket = {remote_close, Socket},
+ socket_type = SocketType,
+ id = Id},
+ profile_name = ProfileName,
+ request = Request,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
+ %% Clobber session
+ (catch httpc_manager:delete_session(Id, ProfileName)),
+
+ maybe_retry_queue(Pipeline, State),
+ maybe_retry_queue(KeepAlive, State),
+
+ %% Cancel timers
+ cancel_timers(Timers),
+
+ %% Maybe deliver answers to requests
+ deliver_answer(Request),
+
+ %% And, just in case, close our side (**really** overkill)
+ http_transport:close(SocketType, Socket);
+
+terminate(_Reason, #state{session = #session{id = Id,
+ socket = Socket,
+ socket_type = SocketType},
+ request = undefined,
+ profile_name = ProfileName,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
+
+ %% Clobber session
+ (catch httpc_manager:delete_session(Id, ProfileName)),
+
+ maybe_retry_queue(Pipeline, State),
+ maybe_retry_queue(KeepAlive, State),
+
+ cancel_timer(Timers#timers.queue_timer, timeout_queue),
+ http_transport:close(SocketType, Socket);
+
+terminate(_Reason, #state{request = undefined}) ->
+ ok;
+
+terminate(Reason, #state{request = Request} = State) ->
+ NewState = maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ terminate(Reason, NewState#state{request = undefined}).
+
+%%--------------------------------------------------------------------
+%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState}
+%% Purpose: Convert process state when code is changed
+%%--------------------------------------------------------------------
+
+code_change(_, State, _) ->
+ {ok, State}.
+
+%%%--------------------------------------------------------------------
+%%% Internal functions
+%%%--------------------------------------------------------------------
+do_handle_call(#request{address = Addr} = Request, _,
#state{status = Status,
session = #session{type = pipeline} = Session,
timers = Timers,
options = #options{proxy = Proxy} = _Options,
profile_name = ProfileName} = State0)
when Status =/= undefined ->
-
- ?hcrv("new request on a pipeline session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status},
- {timers, Timers}]),
-
Address = handle_proxy(Addr, Proxy),
-
case httpc_request:send(Address, Session, Request) of
ok ->
@@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _,
case State0#state.request of
#request{} = OldRequest -> %% Old request not yet finished
- ?hcrd("old request still not finished", []),
%% Make sure to use the new value of timers in state
- NewTimers = State1#state.timers,
+ NewTimers = State1#state.timers,
NewPipeline = queue:in(Request, State1#state.pipeline),
NewSession =
Session#session{queue_length =
@@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _,
queue:len(NewPipeline) + 1,
client_close = ClientClose},
insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
{reply, ok, State1#state{
request = OldRequest,
pipeline = NewPipeline,
@@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _,
undefined ->
%% Note: tcp-message receiving has already been
%% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
cancel_timer(Timers#timers.queue_timer,
timeout_queue),
NewSession =
@@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _,
client_close = ClientClose},
httpc_manager:insert_session(NewSession, ProfileName),
NewTimers = Timers#timers{queue_timer = undefined},
- ?hcrd("session created", []),
State = init_wait_for_response_state(Request, State1#state{session = NewSession,
timers = NewTimers}),
{reply, ok, State}
end;
{error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
NewPipeline = queue:in(Request, State0#state.pipeline),
- {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}}
+ {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}}
end;
-handle_call(#request{address = Addr} = Request, _,
+do_handle_call(#request{address = Addr} = Request, _,
#state{status = Status,
session = #session{type = keep_alive} = Session,
timers = Timers,
@@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _,
profile_name = ProfileName} = State0)
when Status =/= undefined ->
- ?hcrv("new request on a keep-alive session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status}]),
-
ClientClose = httpc_request:is_client_closing(Request#request.headers),
case State0#state.request of
#request{} -> %% Old request not yet finished
%% Make sure to use the new value of timers in state
- ?hcrd("old request still not finished", []),
NewKeepAlive = queue:in(Request, State0#state.keep_alive),
NewSession =
Session#session{queue_length =
@@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _,
queue:len(NewKeepAlive) + 1,
client_close = ClientClose},
insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
{reply, ok, State0#state{keep_alive = NewKeepAlive,
session = NewSession}};
undefined ->
%% Note: tcp-message receiving has already been
%% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
cancel_timer(Timers#timers.queue_timer,
timeout_queue),
NewTimers = Timers#timers{queue_timer = undefined},
@@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _,
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, Request) of
ok ->
- ?hcrd("request sent", []),
-
%% Activate the request time out for the new request
State2 =
activate_request_timeout(State1#state{request = Request}),
@@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _,
State = init_wait_for_response_state(Request, State2#state{session = NewSession}),
{reply, ok, State};
{error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
- {stop, shutdown, {keepalive_failed, Reason}, State1}
+ {stop, {shutdown, {keepalive_failed, Reason}}, State1}
end
end;
-
-handle_call(info, _, State) ->
+do_handle_call(info, _, State) ->
Info = handler_info(State),
{reply, Info, State}.
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-
%% When the request in process has been canceled the handler process is
%% stopped and the pipelined requests will be reissued or remaining
%% requests will be sent on a new connection. This is is
@@ -405,145 +500,102 @@ handle_call(info, _, State) ->
%% handle_keep_alive_queue/2 on the other hand will just skip the
%% request as if it was never issued as in this case the request will
%% not have been sent.
-handle_cast({cancel, RequestId},
+do_handle_cast({cancel, RequestId},
#state{request = #request{id = RequestId} = Request,
- profile_name = ProfileName,
canceled = Canceled} = State) ->
- ?hcrv("cancel current request", [{request_id, RequestId},
- {profile, ProfileName},
- {canceled, Canceled}]),
{stop, normal,
State#state{canceled = [RequestId | Canceled],
request = Request#request{from = answer_sent}}};
-handle_cast({cancel, RequestId},
- #state{profile_name = ProfileName,
- request = #request{id = CurrId},
- canceled = Canceled} = State) ->
- ?hcrv("cancel", [{request_id, RequestId},
- {curr_req_id, CurrId},
- {profile, ProfileName},
- {canceled, Canceled}]),
+do_handle_cast({cancel, RequestId},
+ #state{request = #request{},
+ canceled = Canceled} = State) ->
{noreply, State#state{canceled = [RequestId | Canceled]}};
-handle_cast({cancel, RequestId},
- #state{profile_name = ProfileName,
- request = undefined,
- canceled = Canceled} = State) ->
- ?hcrv("cancel", [{request_id, RequestId},
- {curr_req_id, undefined},
- {profile, ProfileName},
- {canceled, Canceled}]),
+do_handle_cast({cancel, _},
+ #state{request = undefined} = State) ->
{noreply, State};
-
-handle_cast(stream_next, #state{session = Session} = State) ->
+do_handle_cast(stream_next, #state{session = Session} = State) ->
activate_once(Session),
%% Inactivate the #state.once here because we don't want
%% next_body_chunk/1 to activate the socket twice.
{noreply, State#state{once = inactive}}.
-
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
-handle_info({Proto, _Socket, Data},
+do_handle_info({Proto, _Socket, Data},
#state{mfa = {Module, Function, Args},
- request = #request{method = Method,
- stream = Stream} = Request,
+ request = #request{method = Method} = Request,
session = Session,
status_line = StatusLine} = State)
when (Proto =:= tcp) orelse
(Proto =:= ssl) orelse
(Proto =:= httpc_handler) ->
- ?hcri("received data", [{proto, Proto},
- {module, Module},
- {function, Function},
- {method, Method},
- {stream, Stream},
- {session, Session},
- {status_line, StatusLine}]),
-
- FinalResult =
- try Module:Function([Data | Args]) of
- {ok, Result} ->
- ?hcrd("data processed - ok", []),
- handle_http_msg(Result, State);
- {_, whole_body, _} when Method =:= head ->
- ?hcrd("data processed - whole body", []),
- handle_response(State#state{body = <<>>});
- {Module, whole_body, [Body, Length]} ->
- ?hcrd("data processed - whole body", [{length, Length}]),
- {_, Code, _} = StatusLine,
- {Streamed, NewBody, NewRequest} = stream(Body, Request, Code),
- %% When we stream we will not keep the already
- %% streamed data, that would be a waste of memory.
- NewLength =
- case Streamed of
- false ->
- Length;
- true ->
- Length - size(Body)
- end,
-
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, whole_body, [NewBody, NewLength]},
- {noreply, NewState#state{mfa = NewMFA,
- request = NewRequest}};
- {Module, decode_size,
- [TotalChunk, HexList,
+ try Module:Function([Data | Args]) of
+ {ok, Result} ->
+ handle_http_msg(Result, State);
+ {_, whole_body, _} when Method =:= head ->
+ handle_response(State#state{body = <<>>});
+ {Module, whole_body, [Body, Length]} ->
+ {_, Code, _} = StatusLine,
+ {Streamed, NewBody, NewRequest} = stream(Body, Request, Code),
+ %% When we stream we will not keep the already
+ %% streamed data, that would be a waste of memory.
+ NewLength =
+ case Streamed of
+ false ->
+ Length;
+ true ->
+ Length - size(Body)
+ end,
+
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, whole_body, [NewBody, NewLength]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ {Module, decode_size,
+ [TotalChunk, HexList, AccHeaderSize,
{MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
- when BodySoFar =/= <<>> ->
- ?hcrd("data processed - decode_size", []),
- %% The response body is chunk-encoded. Steal decoded
- %% chunks as much as possible to stream.
- {_, Code, _} = StatusLine,
- {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code),
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, decode_size,
- [TotalChunk, HexList,
+ when BodySoFar =/= <<>> ->
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ {_, Code, _} = StatusLine,
+ {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code),
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, decode_size,
+ [TotalChunk, HexList, AccHeaderSize,
{MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ {Module, decode_data,
+ [ChunkSize, TotalChunk,
+ {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
+ when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> ->
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)),
+ <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk,
+ StolenBody = <<BodySoFar/binary, StolenChunk/binary>>,
+ NewChunkSize = ChunkSize - ChunkSizeToSteal,
+ {_, Code, _} = StatusLine,
+
+ {_, NewBody, NewRequest} = stream(StolenBody, Request, Code),
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, decode_data,
+ [NewChunkSize, NewTotalChunk,
+ {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
{noreply, NewState#state{mfa = NewMFA,
request = NewRequest}};
- {Module, decode_data,
- [ChunkSize, TotalChunk,
- {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
- when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> ->
- ?hcrd("data processed - decode_data", []),
- %% The response body is chunk-encoded. Steal decoded
- %% chunks as much as possible to stream.
- ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)),
- <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk,
- StolenBody = <<BodySoFar/binary, StolenChunk/binary>>,
- NewChunkSize = ChunkSize - ChunkSizeToSteal,
- {_, Code, _} = StatusLine,
-
- {_, NewBody, NewRequest} = stream(StolenBody, Request, Code),
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, decode_data,
- [NewChunkSize, NewTotalChunk,
- {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
- {noreply, NewState#state{mfa = NewMFA,
- request = NewRequest}};
- NewMFA ->
- ?hcrd("data processed - new mfa", []),
- activate_once(Session),
- {noreply, State#state{mfa = NewMFA}}
- catch
- _:_Reason ->
- ?hcrd("data processing exit", [{exit, _Reason}]),
- ClientReason = {could_not_parse_as_http, Data},
- ClientErrMsg = httpc_response:error(Request, ClientReason),
- NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState}
- end,
- ?hcri("data processed", [{final_result, FinalResult}]),
- FinalResult;
-
+ NewMFA ->
+ activate_once(Session),
+ {noreply, State#state{mfa = NewMFA}}
+ catch
+ _:Reason ->
+ ClientReason = {could_not_parse_as_http, Data},
+ ClientErrMsg = httpc_response:error(Request, ClientReason),
+ NewState = answer_request(Request, ClientErrMsg, State),
+ {stop, {shutdown, Reason}, NewState}
+ end;
-handle_info({Proto, Socket, Data},
+do_handle_info({Proto, Socket, Data},
#state{mfa = MFA,
request = Request,
session = Session,
@@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data},
{noreply, State};
-
%% The Server may close the connection to indicate that the
%% whole body is now sent instead of sending an length
%% indicator.
-handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
+do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
handle_response(State#state{body = hd(Args)});
-handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
+do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
handle_response(State#state{body = hd(Args)});
%%% Server closes idle pipeline
-handle_info({tcp_closed, _}, State = #state{request = undefined}) ->
+do_handle_info({tcp_closed, _}, State = #state{request = undefined}) ->
{stop, normal, State};
-handle_info({ssl_closed, _}, State = #state{request = undefined}) ->
+do_handle_info({ssl_closed, _}, State = #state{request = undefined}) ->
{stop, normal, State};
%%% Error cases
-handle_info({tcp_closed, _}, #state{session = Session0} = State) ->
+do_handle_info({tcp_closed, _}, #state{session = Session0} = State) ->
Socket = Session0#session.socket,
Session = Session0#session{socket = {remote_close, Socket}},
%% {stop, session_remotly_closed, State};
{stop, normal, State#state{session = Session}};
-handle_info({ssl_closed, _}, #state{session = Session0} = State) ->
+do_handle_info({ssl_closed, _}, #state{session = Session0} = State) ->
Socket = Session0#session.socket,
Session = Session0#session{socket = {remote_close, Socket}},
%% {stop, session_remotly_closed, State};
{stop, normal, State#state{session = Session}};
-handle_info({tcp_error, _, _} = Reason, State) ->
+do_handle_info({tcp_error, _, _} = Reason, State) ->
{stop, Reason, State};
-handle_info({ssl_error, _, _} = Reason, State) ->
+do_handle_info({ssl_error, _, _} = Reason, State) ->
{stop, Reason, State};
%% Timeouts
%% Internally, to a request handling process, a request timeout is
%% seen as a canceled request.
-handle_info({timeout, RequestId},
+do_handle_info({timeout, RequestId},
#state{request = #request{id = RequestId} = Request,
canceled = Canceled,
profile_name = ProfileName} = State) ->
- ?hcri("timeout of current request", [{id, RequestId}]),
httpc_response:send(Request#request.from,
httpc_response:error(Request, timeout)),
httpc_manager:request_done(RequestId, ProfileName),
- ?hcrv("response (timeout) sent - now terminate", []),
{stop, normal,
State#state{request = Request#request{from = answer_sent},
canceled = [RequestId | Canceled]}};
-handle_info({timeout, RequestId},
+do_handle_info({timeout, RequestId},
#state{canceled = Canceled,
profile_name = ProfileName} = State) ->
- ?hcri("timeout", [{id, RequestId}]),
Filter =
fun(#request{id = Id, from = From} = Request) when Id =:= RequestId ->
- ?hcrv("found request", [{id, Id}, {from, From}]),
%% Notify the owner
httpc_response:send(From,
httpc_response:error(Request, timeout)),
httpc_manager:request_done(RequestId, ProfileName),
- ?hcrv("response (timeout) sent", []),
[Request#request{from = answer_sent}];
(_) ->
true
end,
case State#state.status of
pipeline ->
- ?hcrd("pipeline", []),
Pipeline = queue:filter(Filter, State#state.pipeline),
{noreply, State#state{canceled = [RequestId | Canceled],
pipeline = Pipeline}};
keep_alive ->
- ?hcrd("keep_alive", []),
KeepAlive = queue:filter(Filter, State#state.keep_alive),
{noreply, State#state{canceled = [RequestId | Canceled],
keep_alive = KeepAlive}}
end;
-handle_info(timeout_queue, State = #state{request = undefined}) ->
+do_handle_info(timeout_queue, State = #state{request = undefined}) ->
{stop, normal, State};
%% Timing was such as the queue_timeout was not canceled!
-handle_info(timeout_queue, #state{timers = Timers} = State) ->
+do_handle_info(timeout_queue, #state{timers = Timers} = State) ->
{noreply, State#state{timers =
Timers#timers{queue_timer = undefined}}};
%% Setting up the connection to the server somehow failed.
-handle_info({init_error, Tag, ClientErrMsg},
+do_handle_info({init_error, Reason, ClientErrMsg},
State = #state{request = Request}) ->
- ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]),
NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState};
-
+ {stop, {shutdown, Reason}, NewState};
%%% httpc_manager process dies.
-handle_info({'EXIT', _, _}, State = #state{request = undefined}) ->
+do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) ->
{stop, normal, State};
%%Try to finish the current request anyway,
%% there is a fairly high probability that it can be done successfully.
%% Then close the connection, hopefully a new manager is started that
%% can retry requests in the pipeline.
-handle_info({'EXIT', _, _}, State) ->
+do_handle_info({'EXIT', _, _}, State) ->
{noreply, State#state{status = close}}.
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> _ (ignored by gen_server)
-%% Description: Shutdown the httpc_handler
-%%--------------------------------------------------------------------
-
-%% Init error there is no socket to be closed.
-terminate(normal,
- #state{request = Request,
- session = {send_failed, AReason} = Reason} = State) ->
- ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]),
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal,
- #state{request = Request,
- session = {connect_failed, AReason} = Reason} = State) ->
- ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]),
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal, #state{session = undefined}) ->
- ok;
-
-%% Init error sending, no session information has been setup but
-%% there is a socket that needs closing.
-terminate(normal,
- #state{session = #session{id = undefined} = Session}) ->
- close_socket(Session);
-
-%% Socket closed remotely
-terminate(normal,
- #state{session = #session{socket = {remote_close, Socket},
- socket_type = SocketType,
- id = Id},
- profile_name = ProfileName,
- request = Request,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
- ?hcrt("terminate(normal) - remote close",
- [{id, Id}, {profile, ProfileName}]),
-
- %% Clobber session
- (catch httpc_manager:delete_session(Id, ProfileName)),
-
- maybe_retry_queue(Pipeline, State),
- maybe_retry_queue(KeepAlive, State),
-
- %% Cancel timers
- cancel_timers(Timers),
-
- %% Maybe deliver answers to requests
- deliver_answer(Request),
-
- %% And, just in case, close our side (**really** overkill)
- http_transport:close(SocketType, Socket);
-
-terminate(Reason, #state{session = #session{id = Id,
- socket = Socket,
- socket_type = SocketType},
- request = undefined,
- profile_name = ProfileName,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
- ?hcrt("terminate",
- [{id, Id}, {profile, ProfileName}, {reason, Reason}]),
-
- %% Clobber session
- (catch httpc_manager:delete_session(Id, ProfileName)),
-
- maybe_retry_queue(Pipeline, State),
- maybe_retry_queue(KeepAlive, State),
-
- cancel_timer(Timers#timers.queue_timer, timeout_queue),
- http_transport:close(SocketType, Socket);
+call(Msg, Pid) ->
+ call(Msg, Pid, infinity).
-terminate(Reason, #state{request = undefined}) ->
- ?hcrt("terminate", [{reason, Reason}]),
- ok;
+call(Msg, Pid, Timeout) ->
+ gen_server:call(Pid, Msg, Timeout).
-terminate(Reason, #state{request = Request} = State) ->
- ?hcrd("terminate", [{reason, Reason}, {request, Request}]),
- NewState = maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- terminate(Reason, NewState#state{request = undefined}).
+cast(Msg, Pid) ->
+ gen_server:cast(Pid, Msg).
maybe_retry_queue(Q, State) ->
case queue:is_empty(Q) of
@@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) ->
maybe_send_answer(Request, Answer, State) ->
answer_request(Request, Answer, State).
-deliver_answer(#request{id = Id, from = From} = Request)
+deliver_answer(#request{from = From} = Request)
when is_pid(From) ->
Response = httpc_response:error(Request, socket_closed_remotely),
- ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]),
httpc_response:send(From, Response);
-deliver_answer(Request) ->
- ?hcrd("skip deliver answer", [{request, Request}]),
+deliver_answer(_Request) ->
ok.
-
-%%--------------------------------------------------------------------
-%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState}
-%% Purpose: Convert process state when code is changed
-%%--------------------------------------------------------------------
-
-code_change(_, State, _) ->
- {ok, State}.
-
-
-%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts,
-%% Auth, Relaxed}) ->
-%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts,
-%% Auth, Relaxed}.
-
-%% old_http_options({http_options, _, TimeOut, AutoRedirect,
-%% SslOpts, Auth, Relaxed}) ->
-%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}.
-
-%% new_queue(Queue, Fun) ->
-%% List = queue:to_list(Queue),
-%% NewList =
-%% lists:map(fun(Request) ->
-%% Settings =
-%% Fun(Request#request.settings),
-%% Request#request{settings = Settings}
-%% end, List),
-%% queue:from_list(NewList).
-
-
%%%--------------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
@@ -872,26 +799,21 @@ connect(SocketType, ToAddress,
connect_and_send_first_request(Address, Request, #state{options = Options} = State) ->
SocketType = socket_type(Request),
ConnTimeout = (Request#request.settings)#http_options.connect_timeout,
- ?hcri("connect",
- [{address, Address}, {request, Request}, {options, Options}]),
case connect(SocketType, Address, Options, ConnTimeout) of
{ok, Socket} ->
ClientClose =
- httpc_request:is_client_closing(
- Request#request.headers),
+ httpc_request:is_client_closing(
+ Request#request.headers),
SessionType = httpc_manager:session_type(Options),
SocketType = socket_type(Request),
Session = #session{id = {Request#request.address, self()},
scheme = Request#request.scheme,
socket = Socket,
- socket_type = SocketType,
- client_close = ClientClose,
- type = SessionType},
- ?hcri("connected - now send first request", [{socket, Socket}]),
-
+ socket_type = SocketType,
+ client_close = ClientClose,
+ type = SessionType},
case httpc_request:send(Address, Session, Request) of
ok ->
- ?hcri("first request sent", []),
TmpState = State#state{request = Request,
session = Session,
mfa = init_mfa(Request, State),
@@ -949,12 +871,6 @@ handler_info(#state{request = Request,
options = _Options,
timers = _Timers} = _State) ->
- ?hcrt("handler info", [{request, Request},
- {session, Session},
- {pipeline, Pipeline},
- {keep_alive, KeepAlive},
- {status, Status}]),
-
%% Info about the current request
RequestInfo =
case Request of
@@ -965,8 +881,6 @@ handler_info(#state{request = Request,
[{id, Id}, {started, ReqStarted}]
end,
- ?hcrt("handler info", [{request_info, RequestInfo}]),
-
%% Info about the current session/socket
SessionType = Session#session.type,
QueueLen = case SessionType of
@@ -979,22 +893,12 @@ handler_info(#state{request = Request,
Socket = Session#session.socket,
SocketType = Session#session.socket_type,
- ?hcrt("handler info", [{session_type, SessionType},
- {queue_length, QueueLen},
- {scheme, Scheme},
- {socket, Socket}]),
-
SocketOpts = http_transport:getopts(SocketType, Socket),
SocketStats = http_transport:getstat(SocketType, Socket),
Remote = http_transport:peername(SocketType, Socket),
Local = http_transport:sockname(SocketType, Socket),
- ?hcrt("handler info", [{remote, Remote},
- {local, Local},
- {socket_opts, SocketOpts},
- {socket_stats, SocketStats}]),
-
SocketInfo = [{remote, Remote},
{local, Local},
{socket_opts, SocketOpts},
@@ -1014,7 +918,6 @@ handler_info(#state{request = Request,
handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
State = #state{request = Request}) ->
- ?hcrt("handle_http_msg", [{headers, Headers}]),
case Headers#http_response_h.'content-type' of
"multipart/byteranges" ++ _Param ->
exit({not_yet_implemented, multypart_byteranges});
@@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
end;
handle_http_msg({ChunkedHeaders, Body},
#state{status_line = {_, Code, _}, headers = Headers} = State) ->
- ?hcrt("handle_http_msg",
- [{chunked_headers, ChunkedHeaders}, {headers, Headers}]),
NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders),
{_, NewBody, NewRequest} = stream(Body, State#state.request, Code),
handle_response(State#state{headers = NewHeaders,
body = NewBody,
request = NewRequest});
handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) ->
- ?hcrt("handle_http_msg", [{code, Code}]),
{_, NewBody, NewRequest} = stream(Body, State#state.request, Code),
handle_response(State#state{body = NewBody, request = NewRequest}).
@@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request},
{stop, normal, NewState};
handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) ->
- ?hcrt("handle_http_body - 304", []),
handle_response(State#state{body = <<>>});
handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) ->
- ?hcrt("handle_http_body - 204", []),
handle_response(State#state{body = <<>>});
handle_http_body(<<>>, #state{request = #request{method = head}} = State) ->
- ?hcrt("handle_http_body - head", []),
handle_response(State#state{body = <<>>});
handle_http_body(Body, #state{headers = Headers,
max_body_size = MaxBodySize,
status_line = {_,Code, _},
request = Request} = State) ->
- ?hcrt("handle_http_body",
- [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]),
TransferEnc = Headers#http_response_h.'transfer-encoding',
case case_insensitive_header(TransferEnc) of
"chunked" ->
- ?hcrt("handle_http_body - chunked", []),
try http_chunk:decode(Body, State#state.max_body_size,
State#state.max_header_size) of
{Module, Function, Args} ->
- ?hcrt("handle_http_body - new mfa",
- [{module, Module},
- {function, Function},
- {args, Args}]),
NewState = next_body_chunk(State, Code),
{noreply, NewState#state{mfa =
{Module, Function, Args}}};
{ok, {ChunkedHeaders, NewBody}} ->
- ?hcrt("handle_http_body - new body",
- [{chunked_headers, ChunkedHeaders},
- {new_body, NewBody}]),
NewHeaders = http_chunk:handle_headers(Headers,
ChunkedHeaders),
case Body of
@@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers,
{stop, normal, NewState}
end;
Enc when Enc =:= "identity"; Enc =:= undefined ->
- ?hcrt("handle_http_body - identity", []),
Length =
list_to_integer(Headers#http_response_h.'content-length'),
case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of
@@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers,
{stop, normal, NewState}
end;
Encoding when is_list(Encoding) ->
- ?hcrt("handle_http_body - other", [{encoding, Encoding}]),
NewState = answer_request(Request,
httpc_response:error(Request,
unknown_encoding),
@@ -1152,18 +1037,10 @@ handle_response(#state{request = Request,
options = Options,
profile_name = ProfileName} = State)
when Status =/= new ->
-
- ?hcrd("handle response", [{profile, ProfileName},
- {status, Status},
- {request, Request},
- {session, Session},
- {status_line, StatusLine}]),
-
handle_cookies(Headers, Request, Options, ProfileName),
case httpc_response:result({StatusLine, Headers, Body}, Request) of
%% 100-continue
continue ->
- ?hcrd("handle response - continue", []),
%% Send request body
{_, RequestBody} = Request#request.content,
send_raw(Session, RequestBody),
@@ -1180,7 +1057,6 @@ handle_response(#state{request = Request,
%% Ignore unexpected 100-continue response and receive the
%% actual response that the server will send right away.
{ignore, Data} ->
- ?hcrd("handle response - ignore", [{data, Data}]),
Relaxed = (Request#request.settings)#http_options.relaxed,
MFA = {httpc_response, parse,
[State#state.max_header_size, Relaxed]},
@@ -1194,23 +1070,17 @@ handle_response(#state{request = Request,
%% obsolete and the manager will create a new request
%% with the same id as the current.
{redirect, NewRequest, Data} ->
- ?hcrt("handle response - redirect",
- [{new_request, NewRequest}, {data, Data}]),
ok = httpc_manager:redirect_request(NewRequest, ProfileName),
handle_queue(State#state{request = undefined}, Data);
{retry, TimeNewRequest, Data} ->
- ?hcrt("handle response - retry",
- [{time_new_request, TimeNewRequest}, {data, Data}]),
ok = httpc_manager:retry_request(TimeNewRequest, ProfileName),
handle_queue(State#state{request = undefined}, Data);
{ok, Msg, Data} ->
- ?hcrd("handle response - ok", []),
stream_remaining_body(Body, Request, StatusLine),
end_stream(StatusLine, Request),
NewState = maybe_send_answer(Request, Msg, State),
handle_queue(NewState, Data);
{stop, Msg} ->
- ?hcrd("handle response - stop", [{msg, Msg}]),
end_stream(StatusLine, Request),
NewState = maybe_send_answer(Request, Msg, State),
{stop, normal, NewState}
@@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline,
profile_name = ProfileName,
options = #options{pipeline_timeout = TimeOut}} = State,
Data) ->
-
- ?hcrd("handle pipeline", [{profile, ProfileName},
- {session, Session},
- {timeout, TimeOut}]),
-
case queue:out(State#state.pipeline) of
{empty, _} ->
- ?hcrd("pipeline queue empty", []),
handle_empty_queue(Session, ProfileName, TimeOut, State);
{{value, NextRequest}, Pipeline} ->
- ?hcrd("pipeline queue non-empty", []),
case lists:member(NextRequest#request.id,
State#state.canceled) of
true ->
- ?hcrv("next request had been cancelled", []),
%% See comment for handle_cast({cancel, RequestId})
{stop, normal,
State#state{request =
NextRequest#request{from = answer_sent},
pipeline = Pipeline}};
false ->
- ?hcrv("next request", [{request, NextRequest}]),
NewSession =
Session#session{queue_length =
%% Queue + current
@@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive,
options = #options{keep_alive_timeout = TimeOut,
proxy = Proxy}} = State,
Data) ->
-
- ?hcrd("handle keep_alive", [{profile, ProfileName},
- {session, Session},
- {timeout, TimeOut}]),
-
case queue:out(State#state.keep_alive) of
{empty, _} ->
- ?hcrd("keep_alive queue empty", []),
handle_empty_queue(Session, ProfileName, TimeOut, State);
{{value, NextRequest}, KeepAlive} ->
- ?hcrd("keep_alive queue non-empty", []),
case lists:member(NextRequest#request.id,
State#state.canceled) of
true ->
- ?hcrv("next request has already been canceled", []),
handle_keep_alive_queue(
State#state{keep_alive = KeepAlive}, Data);
false ->
- ?hcrv("next request", [{request, NextRequest}]),
#request{address = Addr} = NextRequest,
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, NextRequest) of
@@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive,
end
end
end.
-
handle_empty_queue(Session, ProfileName, TimeOut, State) ->
%% The server may choose too terminate an idle pipline| keep_alive session
%% in this case we want to receive the close message
@@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) ->
status_line = undefined,
headers = undefined,
body = undefined}.
-
gather_data(<<>>, Session, State) ->
activate_once(Session),
{noreply, State};
@@ -1381,10 +1231,6 @@ activate_request_timeout(
State;
_ ->
ReqId = Request#request.id,
- ?hcrt("activate request timer",
- [{request_id, ReqId},
- {time_consumed, t() - Request#request.started},
- {timeout, Timeout}]),
Msg = {timeout, ReqId},
Ref = erlang:send_after(Timeout, self(), Msg),
Request2 = Request#request{timer = Ref},
@@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive(
status_line = {Version, _, _},
headers = Headers,
profile_name = ProfileName} = State) ->
- ?hcrd("try to enable pipeline or keep-alive",
- [{version, Version},
- {headers, Headers},
- {session, Session}]),
case is_keep_alive_enabled_server(Version, Headers) andalso
is_keep_alive_connection(Headers, Session) of
true ->
@@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg,
#state{session = Session,
timers = Timers,
profile_name = ProfileName} = State) ->
- ?hcrt("answer request", [{request, Request}, {msg, Msg}]),
httpc_response:send(From, Msg),
RequestTimers = Timers#timers.request_timers,
TimerRef =
@@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) ->
ip_comm;
socket_type(#request{scheme = https, settings = Settings}) ->
Settings#http_options.ssl.
-%% socket_type(http) ->
-%% ip_comm;
-%% socket_type(https) ->
-%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value
start_stream({_Version, _Code, _ReasonPhrase}, _Headers,
#request{stream = none} = Request) ->
- ?hcrt("start stream - none", []),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, Headers,
#request{stream = self} = Request)
when ?IS_STREAMED(Code) ->
- ?hcrt("start stream - self", [{code, Code}]),
Msg = httpc_response:stream_start(Headers, Request, ignore),
httpc_response:send(Request#request.from, Msg),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, Headers,
#request{stream = {self, once}} = Request)
when ?IS_STREAMED(Code) ->
- ?hcrt("start stream - self:once", [{code, Code}]),
Msg = httpc_response:stream_start(Headers, Request, self()),
httpc_response:send(Request#request.from, Msg),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, _Headers,
#request{stream = Filename} = Request)
when ?IS_STREAMED(Code) andalso is_list(Filename) ->
- ?hcrt("start stream", [{code, Code}, {filename, Filename}]),
case file:open(Filename, [write, raw, append, delayed_write]) of
{ok, Fd} ->
- ?hcri("start stream - file open ok", [{fd, Fd}]),
{ok, Request#request{stream = Fd}};
{error, Reason} ->
exit({stream_to_file_failed, Reason})
end;
start_stream(_StatusLine, _Headers, Request) ->
- ?hcrt("start stream - no op", []),
{ok, Request}.
stream_remaining_body(<<>>, _, _) ->
@@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) ->
%% Note the end stream message is handled by httpc_response and will
%% be sent by answer_request
end_stream(_, #request{stream = none}) ->
- ?hcrt("end stream - none", []),
ok;
end_stream(_, #request{stream = self}) ->
- ?hcrt("end stream - self", []),
ok;
end_stream(_, #request{stream = {self, once}}) ->
- ?hcrt("end stream - self:once", []),
ok;
end_stream({_,200,_}, #request{stream = Fd}) ->
- ?hcrt("end stream - 200", [{stream, Fd}]),
case file:close(Fd) of
ok ->
ok;
@@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) ->
file:close(Fd)
end;
end_stream({_,206,_}, #request{stream = Fd}) ->
- ?hcrt("end stream - 206", [{stream, Fd}]),
case file:close(Fd) of
ok ->
ok;
{error, enospc} -> % Could be due to delayed_write
file:close(Fd)
end;
-end_stream(SL, R) ->
- ?hcrt("end stream", [{status_line, SL}, {request, R}]),
+end_stream(_, _) ->
ok.
@@ -1702,11 +1527,8 @@ handle_verbose(trace) ->
handle_verbose(_) ->
ok.
-
-
send_raw(#session{socket = Socket, socket_type = SocketType},
{ProcessBody, Acc}) when is_function(ProcessBody, 1) ->
- ?hcrt("send raw", [{acc, Acc}]),
send_raw(SocketType, Socket, ProcessBody, Acc);
send_raw(#session{socket = Socket, socket_type = SocketType}, Body) ->
http_transport:send(SocketType, Socket, Body).
@@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) ->
ok;
{ok, Data, NewAcc} ->
DataBin = iolist_to_binary(Data),
- ?hcrd("send", [{data, DataBin}]),
case http_transport:send(SocketType, Socket, DataBin) of
ok ->
send_raw(SocketType, Socket, ProcessBody, NewAcc);
@@ -1883,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
end.
-%% ---------------------------------------------------------------------
-
-call(Msg, Pid) ->
- call(Msg, Pid, infinity).
-
-call(Msg, Pid, Timeout) ->
- gen_server:call(Pid, Msg, Timeout).
-
-cast(Msg, Pid) ->
- gen_server:cast(Pid, Msg).
-
-t() ->
- http_util:timestamp().
diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl
index d8bdac24e3..0fd5faa466 100644
--- a/lib/inets/src/http_client/httpc_response.erl
+++ b/lib/inets/src/http_client/httpc_response.erl
@@ -363,7 +363,7 @@ redirect(Response = {StatusLine, Headers, Body}, Request) ->
%% Automatic redirection
{ok, {Scheme, _, Host, Port, Path, Query}} ->
NewHeaders =
- (Request#request.headers)#http_request_h{host = Host},
+ (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)},
NewRequest =
Request#request{redircount =
Request#request.redircount+1,
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index a64ae2b87c..8aea38037d 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -88,7 +88,8 @@ real_requests()->
stream_through_mfa,
streaming_error,
inet_opts,
- invalid_headers
+ invalid_headers,
+ invalid_body
].
only_simulated() ->
@@ -125,7 +126,9 @@ only_simulated() ->
redirect_see_other,
redirect_temporary_redirect,
port_in_host_header,
- relaxed
+ redirect_port_in_host_header,
+ relaxed,
+ multipart_chunks
].
misc() ->
@@ -1000,10 +1003,25 @@ invalid_headers(Config) ->
Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]},
{error, _} = httpc:request(get, Request, [], []).
+%%-------------------------------------------------------------------------
+
+invalid_body(Config) ->
+ URL = url(group_name(Config), "/dummy.html", Config),
+ try
+ httpc:request(post, {URL, [], <<"text/plain">>, "foobar"},
+ [], []),
+ ct:fail(accepted_invalid_input)
+ catch
+ error:function_clause ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
remote_socket_close(Config) when is_list(Config) ->
URL = url(group_name(Config), "/just_close.html", Config),
{error, socket_closed_remotely} = httpc:request(URL).
+
%%-------------------------------------------------------------------------
remote_socket_close_async(Config) when is_list(Config) ->
@@ -1102,7 +1120,20 @@ port_in_host_header(Config) when is_list(Config) ->
Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []},
{ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
inets_test_lib:check_body(Body).
+%%-------------------------------------------------------------------------
+redirect_port_in_host_header(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/redirect_ensure_host_header_with_port.html", Config), []},
+ {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
+ inets_test_lib:check_body(Body).
+
+%%-------------------------------------------------------------------------
+multipart_chunks(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/multipart_chunks.html", Config), []},
+ {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]),
+ ok = receive_stream_n(Ref, 10),
+ httpc:cancel_request(Ref).
+
%%-------------------------------------------------------------------------
timeout_memory_leak() ->
[{doc, "Check OTP-8739"}].
@@ -1398,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) ->
end.
dummy_server_init(Caller, ip_comm, Inet, _) ->
- BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}],
+ BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}],
{ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]),
{ok, Port} = inet:port(ListenSocket),
Caller ! {port, Port},
@@ -1680,6 +1711,12 @@ handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) ->
"HTTP/1.1 500 Internal Server Error\r\n" ++
"Content-Length:" ++ Len ++ "\r\n\r\n" ++ B
end;
+handle_uri(_,"/redirect_ensure_host_header_with_port.html",Port,_,Socket,_) ->
+ NewUri = url_start(Socket) ++
+ integer_to_list(Port) ++ "/ensure_host_header_with_port.html",
+ "HTTP/1.1 302 Found \r\n" ++
+ "Location:" ++ NewUri ++ "\r\n" ++
+ "Content-Length:0\r\n\r\n";
handle_uri(_,"/300.html",Port,_,Socket,_) ->
NewUri = url_start(Socket) ++
@@ -1968,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) ->
"Content-Length:32\r\n\n" ++
"<HTML><BODY>foobar</BODY></HTML>";
+handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) ->
+ Head = "HTTP/1.1 200 ok\r\n" ++
+ "Transfer-Encoding:chunked\r\n" ++
+ "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n"
+ "Connection: Keep-Alive\r\n" ++
+ "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++
+ "\r\n",
+ send(Socket, Head),
+ send_multipart_chunks(Socket),
+ http_chunk:encode_last();
handle_uri("HEAD",_,_,_,_,_) ->
"HTTP/1.1 200 ok\r\n" ++
"Content-Length:0\r\n\r\n";
@@ -2264,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) ->
Error ->
exit(Error)
end.
+
+send_multipart_chunks(Socket) ->
+ send(Socket, http_chunk:encode("--chunk_boundary\r\n")),
+ send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")),
+ send(Socket, http_chunk:encode("test\r\n")),
+ ct:sleep(500),
+ send_multipart_chunks(Socket).
+
+receive_stream_n(_, 0) ->
+ ok;
+receive_stream_n(Ref, N) ->
+ receive
+ {http, {Ref, stream_start, _}} ->
+ receive_stream_n(Ref, N);
+ {http, {Ref,stream, Data}} ->
+ ct:pal("Data: ~p", [Data]),
+ receive_stream_n(Ref, N-1)
+ end.
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 59a046bf4d..5b5b71e521 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -37,10 +37,7 @@
the <c>heart</c> port program is to check that the Erlang runtime system
it is supervising is still running. If the port program has not
received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds
- (defaults to 60 seconds), the system can be rebooted. Also, if
- the system is equipped with a hardware watchdog timer and is
- running Solaris, the watchdog can be used to supervise the entire
- system.</p>
+ (defaults to 60 seconds), the system can be rebooted.</p>
<p>An Erlang runtime system to be monitored by a heart program
is to be started with command-line flag <c>-heart</c> (see
also <seealso marker="erts:erl"><c>erl(1)</c></seealso>).
@@ -51,17 +48,13 @@
or a terminated Erlang runtime system, environment variable
<c>HEART_COMMAND</c> must be set before the system is started.
If this variable is not set, a warning text is printed but
- the system does not reboot. However, if the hardware watchdog is
- used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c>
- seconds later (defaults to 60 seconds).</p>
+ the system does not reboot.</p>
<p>To reboot on Windows, <c>HEART_COMMAND</c> can be
set to <c>heart -shutdown</c> (included in the Erlang delivery)
or to any other suitable program that can activate a reboot.</p>
- <p>The hardware watchdog is not started under Solaris if
- environment variable <c>HW_WD_DISABLE</c> is set.</p>
- <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and
- <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart
- time-outs; they can be set in the operating system shell before Erlang
+ <p>The environment variable <c>HEART_BEAT_TIMEOUT</c>
+ can be used to configure the heart
+ time-outs; it can be set in the operating system shell before Erlang
is started or be specified at the command line:</p>
<pre>
% <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre>
diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl
index eea78aabdf..8fa48d56fb 100644
--- a/lib/kernel/src/heart.erl
+++ b/lib/kernel/src/heart.erl
@@ -198,16 +198,11 @@ start_portprogram() ->
end.
get_heart_timeouts() ->
- HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of
- false -> "";
- H when is_list(H) ->
- "-ht " ++ H
- end,
- HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of
- false -> "";
- W when is_list(W) ->
- " -wt " ++ W
- end.
+ case os:getenv("HEART_BEAT_TIMEOUT") of
+ false -> "";
+ H when is_list(H) ->
+ "-ht " ++ H
+ end.
check_start_heart() ->
case init:get_argument(heart) of
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index 2f9f81104a..13e73f027d 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -928,7 +928,10 @@ general_info(File) ->
WholeLine -> WholeLine
end,
- GI = get_general_info(Fd,#general_info{created=Created}),
+ {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]),
+ GI = get_general_info(Fd,#general_info{created=Created,
+ slogan=Slogan,
+ system_vsn=SysVsn}),
{MemTot,MemMax} =
case lookup_index(?memory) of
@@ -982,12 +985,20 @@ general_info(File) ->
mem_max=MemMax,
instr_info=InstrInfo}.
+get_slogan_and_sysvsn(Fd,Acc) ->
+ case val(Fd,eof) of
+ "Slogan: " ++ SloganPart when Acc==[] ->
+ get_slogan_and_sysvsn(Fd,[SloganPart]);
+ "System version: " ++ SystemVsn ->
+ {lists:append(lists:reverse(Acc)),SystemVsn};
+ eof ->
+ {lists:append(lists:reverse(Acc)),"-1"};
+ SloganPart ->
+ get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc])
+ end.
+
get_general_info(Fd,GenInfo) ->
case line_head(Fd) of
- "Slogan" ->
- get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)});
- "System version" ->
- get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)});
"Compiled" ->
get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)});
"Taints" ->
diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl
index fcb900960b..925f4456bb 100644
--- a/lib/observer/src/etop.erl
+++ b/lib/observer/src/etop.erl
@@ -23,7 +23,7 @@
-export([start/0, start/1, config/2, stop/0, dump/1, help/0]).
%% Internal
-export([update/1]).
--export([loadinfo/1, meminfo/2, getopt/2]).
+-export([loadinfo/2, meminfo/2, getopt/2]).
-include("etop.hrl").
-include("etop_defs.hrl").
@@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"});
output(text) -> etop_txt.
-loadinfo(SysI) ->
+loadinfo(SysI,Prev) ->
#etop_info{n_procs = Procs,
run_queue = RQ,
now = Now,
wall_clock = WC,
runtime = RT} = SysI,
- Cpu = calculate_cpu_utilization(WC,RT),
+ Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime),
Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w",
tuple_to_list(element(2,calendar:now_to_datetime(Now)))),
{Cpu,Procs,RQ,Clock}.
-calculate_cpu_utilization({_,WC},{_,RT}) ->
+calculate_cpu_utilization({_,WC},{_,RT},_) ->
%% Old version of observer_backend, using statistics(wall_clock)
%% and statistics(runtime)
case {WC,RT} of
@@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) ->
_ ->
round(100*RT/WC)
end;
-calculate_cpu_utilization(_,undefined) ->
+calculate_cpu_utilization(_,undefined,_) ->
%% First time collecting - no cpu utilization has been measured
%% since scheduler_wall_time flag is not yet on
0;
-calculate_cpu_utilization(_,RTInfo) ->
+calculate_cpu_utilization(WC,RTInfo,undefined) ->
+ %% Second time collecting - RTInfo shows scheduler_wall_time since
+ %% flag was set to true. Faking previous values by setting
+ %% everything to zero.
+ ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo],
+ calculate_cpu_utilization(WC,RTInfo,ZeroRT);
+calculate_cpu_utilization(_,RTInfo,PrevRTInfo) ->
%% New version of observer_backend, using statistics(scheduler_wall_time)
- Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end,
+ Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) ->
+ {(A1 - A0)+AAcc,(T1 - T0)+TAcc}
+ end,
{0,0},
- RTInfo),
+ lists:zip(PrevRTInfo,RTInfo)),
case Sum of
{0,0} ->
0;
diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl
index 3b4c176478..6b8f9df24f 100644
--- a/lib/observer/src/etop_txt.erl
+++ b/lib/observer/src/etop_txt.erl
@@ -22,35 +22,35 @@
%%-compile(export_all).
-export([init/1,stop/1]).
--export([do_update/3]).
+-export([do_update/4]).
-include("etop.hrl").
-include("etop_defs.hrl").
--import(etop,[loadinfo/1,meminfo/2]).
+-import(etop,[loadinfo/2,meminfo/2]).
-define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n").
stop(Pid) -> Pid ! stop.
init(Config) ->
- loop(Config).
+ loop(#etop_info{},Config).
-loop(Config) ->
- Info = do_update(Config),
+loop(Prev,Config) ->
+ Info = do_update(Prev,Config),
receive
stop -> stopped;
- {dump,Fd} -> do_update(Fd,Info,Config), loop(Config);
- {config,_,Config1} -> loop(Config1)
- after Config#opts.intv -> loop(Config)
+ {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config);
+ {config,_,Config1} -> loop(Info,Config1)
+ after Config#opts.intv -> loop(Info,Config)
end.
-do_update(Config) ->
+do_update(Prev,Config) ->
Info = etop:update(Config),
- do_update(standard_io,Info,Config).
+ do_update(standard_io,Info,Prev,Config).
-do_update(Fd,Info,Config) ->
- {Cpu,NProcs,RQ,Clock} = loadinfo(Info),
+do_update(Fd,Info,Prev,Config) ->
+ {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev),
io:nl(Fd),
writedoubleline(Fd),
case Info#etop_info.memi of
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 59a2f9f205..1eaba31a3a 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -461,14 +461,16 @@ create_box(Parent, Data) ->
link_entry(Panel,Value);
_ ->
Value = to_str(Value0),
- case length(Value) > 100 of
- true ->
- Shown = lists:sublist(Value, 80),
+ case string:sub_word(lists:sublist(Value, 80),1,$\n) of
+ Value ->
+ %% Short string, no newlines - show all
+ wxStaticText:new(Panel, ?wxID_ANY, Value);
+ Shown ->
+ %% Long or with newlines,
+ %% use tooltip to show all
TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]),
wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)),
- TCtrl;
- false ->
- wxStaticText:new(Panel, ?wxID_ANY, Value)
+ TCtrl
end
end,
wxSizer:add(Line, 10, 0), % space of size 10 horisontally
diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl
index ee6829b847..f07b9e295a 100644
--- a/lib/observer/src/observer_pro_wx.erl
+++ b/lib/observer/src/observer_pro_wx.erl
@@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs,
table_holder(S0);
{dump, Fd} ->
EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)},
- etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}),
+ %% The empty #etop_info{} below is a dummy previous info
+ %% value. It is used by etop to calculate the scheduler
+ %% utilization since last update. When dumping to file,
+ %% there is no previous measurement to use, so we just add
+ %% a dummy here, and the value shown will be since the
+ %% tool was started.
+ etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}),
file:close(Fd),
table_holder(S0);
stop ->
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index e943fb4a3e..b27bc63d15 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -314,13 +314,12 @@ etop_collect(Collector) ->
case SchedulerWallTime of
undefined ->
- spawn(fun() -> flag_holder_proc(Collector) end),
+ erlang:system_flag(scheduler_wall_time,true),
+ spawn(fun() -> flag_holder_proc(Collector) end),
ok;
_ ->
ok
- end,
-
- erlang:system_flag(scheduler_wall_time,true).
+ end.
flag_holder_proc(Collector) ->
Ref = erlang:monitor(process,Collector),
diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start
index 87275045b1..eab2b77aed 100755
--- a/lib/sasl/test/release_handler_SUITE_data/start
+++ b/lib/sasl/test/release_handler_SUITE_data/start
@@ -21,8 +21,7 @@ then
fi
HEART_COMMAND=$ROOTDIR/bin/start
-HW_WD_DISABLE=true
-export HW_WD_DISABLE HEART_COMMAND
+export HEART_COMMAND
START_ERL_DATA=${1:-$RELDIR/start_erl.data}
diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client
index 5ea94d6f7c..05d744f06e 100755
--- a/lib/sasl/test/release_handler_SUITE_data/start_client
+++ b/lib/sasl/test/release_handler_SUITE_data/start_client
@@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases
# Note that this scripts is modified an copied to $CLIENTDIR/bin/start
# in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows:
HEART_COMMAND=$CLIENTDIR/bin/start
-HW_WD_DISABLE=true
-export HW_WD_DISABLE HEART_COMMAND
+export HEART_COMMAND
START_ERL_DATA=${1:-$RELDIR/start_erl.data}
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index ac35b70209..9b54ecb2dd 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -406,7 +406,11 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1,
kb_tries_left = KbTriesLeft,
user = User,
userauth_supported_methods = Methods} = Ssh) ->
- SendOneEmpty = proplists:get_value(tstflg, Opts) == one_empty,
+ SendOneEmpty =
+ (proplists:get_value(tstflg,Opts) == one_empty)
+ orelse
+ proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false),
+
case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of
{true,Ssh1} when SendOneEmpty==true ->
Msg = #ssh_msg_userauth_info_request{name = "",
diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl
index 78f452df67..e444e52ac0 100644
--- a/lib/ssh/src/ssh_sftpd_file_api.erl
+++ b/lib/ssh/src/ssh_sftpd_file_api.erl
@@ -36,7 +36,7 @@
-callback list_dir(file:name(), State::term()) ->
{{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}.
-callback make_dir(Dir::term(), State::term()) ->
- {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}.
+ {ok, State::term()} | {{error, Reason::term()}, State::term()}.
-callback make_symlink(Path2::term(), Path::term(), State::term()) ->
{ok, State::term()} | {{error, Reason::term()}, State::term()}.
-callback open(Path::term(), Flags::term(), State::term()) ->
diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
index dc3b7dc7e6..0f8a838f97 100644
--- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
+++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
@@ -54,15 +54,18 @@
-endif.
-endif.
+%% Public key records:
+-include_lib("public_key/include/public_key.hrl").
%%% Properties:
prop_ssh_decode() ->
- ?FORALL(Msg, ssh_msg(),
- try ssh_message:decode(Msg)
+ ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ),
+ try ssh_message:decode(decode_state(Msg,KexFam))
of
_ -> true
catch
+
C:E -> io:format('~p:~p~n',[C,E]),
false
end
@@ -71,122 +74,101 @@ prop_ssh_decode() ->
%%% This fails because ssh_message is not symmetric in encode and decode regarding data types
prop_ssh_decode_encode() ->
- ?FORALL(Msg, ssh_msg(),
- Msg == ssh_message:encode(ssh_message:decode(Msg))
+ ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ),
+ Msg == ssh_message:encode(
+ fix_asym(
+ ssh_message:decode(decode_state(Msg,KexFam))))
).
%%%================================================================
%%%
-%%% Scripts to generate message generators
-%%%
-
-%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt
-
-%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt
-
-%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt
-
-%%%================================================================
-%%%
%%% Generators
%%%
-ssh_msg() -> ?LET(M,oneof(
-[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()],
- [msg_code('SSH_MSG_IGNORE'),gen_string( )],
- %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()],
- %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )],
- %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()],
- [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()],
- [msg_code('SSH_MSG_NEWKEYS')],
- [msg_code('SSH_MSG_REQUEST_FAILURE')],
- [msg_code('SSH_MSG_REQUEST_SUCCESS')],
- [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()],
- [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )],
- [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )],
- [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()],
- [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()],
- [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_SUCCESS')]
-]
-
-), list_to_binary(M)).
-
-
-%%%================================================================
-%%%
-%%% Generator
-%%%
-
-do() ->
- io_lib:format('[~s~n]',
- [write_gen(
- files(["rfc4254.txt",
- "rfc4253.txt",
- "rfc4419.txt",
- "rfc4252.txt",
- "rfc4256.txt"]))]).
-
-
-write_gen(L) when is_list(L) ->
- string:join(lists:map(fun write_gen/1, L), ",\n ");
-write_gen({MsgName,Args}) ->
- lists:flatten(["[",generate_args([MsgName|Args]),"]"]).
-
-generate_args(As) -> string:join([generate_arg(A) || A <- As], ",").
-
-generate_arg({<<"string">>, <<"\"",B/binary>>}) ->
- S = get_string($",B),
- ["gen_string(\"",S,"\")"];
-generate_arg({<<"string">>, _}) -> "gen_string( )";
-generate_arg({<<"byte[",B/binary>>, _}) ->
- io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]);
-generate_arg({<<"byte">> ,_}) -> "gen_byte()";
-generate_arg({<<"uint16">>,_}) -> "gen_uint16()";
-generate_arg({<<"uint32">>,_}) -> "gen_uint32()";
-generate_arg({<<"uint64">>,_}) -> "gen_uint64()";
-generate_arg({<<"mpint">>,_}) -> "gen_mpint()";
-generate_arg({<<"name-list">>,_}) -> "gen_name_list()";
-generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0";
-generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1";
-generate_arg({<<"boolean">>,_}) -> "gen_boolean()";
-generate_arg({<<"....">>,_}) -> ""; %% FIXME
-generate_arg(Name) when is_binary(Name) ->
- lists:flatten(["msg_code('",binary_to_list(Name),"')"]).
-
+ssh_msg(<<"dh">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], % 30
+ [msg_code('SSH_MSG_KEXDH_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M));
+
+ssh_msg(<<"dh_gex">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST_OLD'),gen_uint32()], % 30
+ [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M));
+
+ ssh_msg(<<"ecdh">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEX_ECDH_INIT'),gen_mpint()], % 30
+ [msg_code('SSH_MSG_KEX_ECDH_REPLY'),gen_pubkey_string(ecdsa),gen_mpint(),gen_signature_string(ecdsa)] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M)).
+
+
+rest_ssh_msgs() ->
+ [%% SSH_MSG_USERAUTH_INFO_RESPONSE
+ %% hard args SSH_MSG_USERAUTH_INFO_REQUEST
+ %% rfc4252 p12 error SSH_MSG_USERAUTH_REQUEST
+ [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST'),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_KEX_DH_GEX_INIT'),gen_mpint()],
+ [msg_code('SSH_MSG_KEX_DH_GEX_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)],
+ [msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()],
+ [msg_code('SSH_MSG_IGNORE'),gen_string( )],
+ [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()],
+ [msg_code('SSH_MSG_NEWKEYS')],
+ [msg_code('SSH_MSG_REQUEST_FAILURE')],
+ [msg_code('SSH_MSG_REQUEST_SUCCESS')],
+ [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()],
+ [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )],
+ [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )],
+ [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()],
+ [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()],
+ [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_SUCCESS')]
+ ].
+
+kex_family() -> oneof([<<"dh">>, <<"dh_gex">>, <<"ecdh">>]).
gen_boolean() -> choose(0,1).
@@ -230,13 +212,22 @@ gen_name() -> gen_string().
uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>).
-%%%----
-get_string(Delim, B) ->
- binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ).
-
-count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc;
-count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1).
+gen_pubkey_string(Type) ->
+ PubKey = case Type of
+ rsa -> #'RSAPublicKey'{modulus = 12345,publicExponent = 2};
+ ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]},
+ {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256
+ end,
+ gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)).
+
+gen_signature_string(Type) ->
+ Signature = <<"hejhopp">>,
+ Id = case Type of
+ rsa -> "ssh-rsa";
+ ecdsa -> "ecdsa-sha2-nistp256"
+ end,
+ gen_string(gen_string(Id) ++ gen_string(Signature)).
-define(MSG_CODE(Name,Num),
msg_code(Name) -> Num;
@@ -273,124 +264,34 @@ msg_code(Num) -> Name
?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100);
?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60);
?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61);
+?MSG_CODE('SSH_MSG_KEXDH_INIT', 30);
+?MSG_CODE('SSH_MSG_KEXDH_REPLY', 31);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32);
-?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33).
-
-%%%=============================================================================
-%%%=============================================================================
-%%%=============================================================================
-
-files(Fs) ->
- Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))),
- DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]),
- WantedIDs = lists:usort(wanted_messages()),
- Missing = WantedIDs -- DefinedIDs,
- case Missing of
- [] -> ok;
- _ -> io:format('%% Warning: missing ~p~n', [Missing])
- end,
- Defs.
-
-
-file(F) ->
- {ok,B} = file:read_file(F),
- hunt_msg_def(B).
-
-
-hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B));
-hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B);
-hunt_msg_def(<<>>) -> [].
-
-some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B));
-some_hope(B) -> hunt_msg_def(B).
-
-try_message(B = <<"SSH_MSG_",_/binary>>) ->
- {ID,Rest} = get_id(B),
- case lists:member(binary_to_list(ID), wanted_messages()) of
- true ->
- {Lines,More} = get_def_lines(skip_blanks(Rest), []),
- [{ID,lists:reverse(Lines)} | hunt_msg_def(More)];
- false ->
- hunt_msg_def(Rest)
- end;
-try_message(B) -> hunt_msg_def(B).
-
-
-skip_blanks(<<32, B/binary>>) -> skip_blanks(B);
-skip_blanks(<< 9, B/binary>>) -> skip_blanks(B);
-skip_blanks(B) -> B.
-
-get_def_lines(B0 = <<"\n",B/binary>>, Acc) ->
- {ID,Rest} = get_id(skip_blanks(B)),
- case {size(ID), skip_blanks(Rest)} of
- {0,<<"....",More/binary>>} ->
- {Text,LineEnd} = get_to_eol(skip_blanks(More)),
- get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]);
- {0,_} ->
- {Acc,B0};
- {_,Rest1} ->
- {Text,LineEnd} = get_to_eol(Rest1),
- get_def_lines(LineEnd, [{ID,Text}|Acc])
- end;
-get_def_lines(B, Acc) ->
- {Acc,B}.
-
-
-get_to_eol(B) -> split_binary(B, count_to_eol(B,0)).
-
-count_to_eol(<<"\n",_/binary>>, Acc) -> Acc;
-count_to_eol(<<>>, Acc) -> Acc;
-count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1).
-
-
-get_id(B) -> split_binary(B, count_id_chars(B,0)).
-
-count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1);
-count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1);
-count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1);
-count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1);
-count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list
-count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16]
-count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16]
-count_id_chars(_, Acc) -> Acc.
-
-wanted_messages() ->
- ["SSH_MSG_CHANNEL_CLOSE",
- "SSH_MSG_CHANNEL_DATA",
- "SSH_MSG_CHANNEL_EOF",
- "SSH_MSG_CHANNEL_EXTENDED_DATA",
- "SSH_MSG_CHANNEL_FAILURE",
- "SSH_MSG_CHANNEL_OPEN",
- "SSH_MSG_CHANNEL_OPEN_CONFIRMATION",
- "SSH_MSG_CHANNEL_OPEN_FAILURE",
- "SSH_MSG_CHANNEL_REQUEST",
- "SSH_MSG_CHANNEL_SUCCESS",
- "SSH_MSG_CHANNEL_WINDOW_ADJUST",
- "SSH_MSG_DEBUG",
- "SSH_MSG_DISCONNECT",
- "SSH_MSG_GLOBAL_REQUEST",
- "SSH_MSG_IGNORE",
- "SSH_MSG_KEXDH_INIT",
- "SSH_MSG_KEXDH_REPLY",
- "SSH_MSG_KEXINIT",
- "SSH_MSG_KEX_DH_GEX_GROUP",
- "SSH_MSG_KEX_DH_GEX_REQUEST",
- "SSH_MSG_KEX_DH_GEX_REQUEST_OLD",
- "SSH_MSG_NEWKEYS",
- "SSH_MSG_REQUEST_FAILURE",
- "SSH_MSG_REQUEST_SUCCESS",
- "SSH_MSG_SERVICE_ACCEPT",
- "SSH_MSG_SERVICE_REQUEST",
- "SSH_MSG_UNIMPLEMENTED",
- "SSH_MSG_USERAUTH_BANNER",
- "SSH_MSG_USERAUTH_FAILURE",
-%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST",
-%% "SSH_MSG_USERAUTH_INFO_RESPONSE",
- "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ",
- "SSH_MSG_USERAUTH_PK_OK",
-%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST",
- "SSH_MSG_USERAUTH_SUCCESS"].
+?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33);
+?MSG_CODE('SSH_MSG_KEX_ECDH_INIT', 30);
+?MSG_CODE('SSH_MSG_KEX_ECDH_REPLY', 31).
+
+%%%====================================================
+%%%=== WARNING: Knowledge of the test object ahead! ===
+%%%====================================================
+
+%% SSH message records:
+-include_lib("ssh/src/ssh_connect.hrl").
+-include_lib("ssh/src/ssh_transport.hrl").
+
+%%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :(
+fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)};
+fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D),
+ language = binary_to_list(L)};
+fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>};
+fix_asym(M) -> M.
+
+%%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder
+%%% input as the test object does
+decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>;
+decode_state(<<31,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>;
+decode_state(Msg, _) -> Msg.
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index 8b2db0e1a8..14605ee44f 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -198,7 +198,7 @@ try_exec_simple_group(Group, Config) ->
%%--------------------------------------------------------------------
%% Testing all default groups
-simple_exec_groups() -> [{timetrap,{minutes,5}}].
+simple_exec_groups() -> [{timetrap,{minutes,8}}].
simple_exec_groups(Config) ->
Sizes = interpolate( public_key:dh_gex_group_sizes() ),
@@ -206,10 +206,8 @@ simple_exec_groups(Config) ->
fun(Sz) ->
ct:log("Try size ~p",[Sz]),
ct:comment(Sz),
- case simple_exec_group(Sz, Config) of
- expected -> ct:log("Size ~p ok",[Sz]);
- _ -> ct:log("Size ~p not ok",[Sz])
- end
+ simple_exec_group(Sz, Config),
+ ct:log("Size ~p ok",[Sz])
end, Sizes),
ct:comment("~p",[lists:map(fun({_,I,_}) -> I;
(I) -> I
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index 8f060bebd8..86f5cb1746 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -831,10 +831,13 @@ supported_hash(HashAlg) ->
really_do_hostkey_fingerprint_check(Config, HashAlg) ->
PrivDir = proplists:get_value(priv_dir, Config),
- UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
- file:make_dir(UserDir),
+ UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDirServer),
SysDir = proplists:get_value(data_dir, Config),
+ UserDirClient =
+ ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs
+
%% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint
%% function since that function is used by the ssh client...
FPs = [case HashAlg of
@@ -857,7 +860,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
%% Start daemon with the public keys that we got fingerprints from
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, UserDir},
+ {user_dir, UserDirServer},
{password, "morot"}]),
FP_check_fun = fun(PeerName, FP) ->
@@ -876,7 +879,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
end},
{user, "foo"},
{password, "morot"},
- {user_dir, UserDir},
+ {user_dir, UserDirClient},
{user_interaction, false}]),
ssh:stop_daemon(Pid).
diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl
index 7ba2732a88..9b2a84d8e4 100644
--- a/lib/ssh/test/ssh_property_test_SUITE.erl
+++ b/lib/ssh/test/ssh_property_test_SUITE.erl
@@ -68,9 +68,6 @@ init_per_group(_, Config) ->
end_per_group(_, Config) ->
Config.
-%%% Always skip the testcase that is not quite in phase with the
-%%% ssh_message.erl code
-init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"};
init_per_testcase(_TestCase, Config) -> Config.
end_per_testcase(_TestCase, Config) -> Config.
diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl
index 70662f5d93..acf76157a2 100644
--- a/lib/ssh/test/ssh_sftp_SUITE.erl
+++ b/lib/ssh/test/ssh_sftp_SUITE.erl
@@ -1038,7 +1038,7 @@ oldprep(Config) ->
prepare(Config0) ->
PrivDir = proplists:get_value(priv_dir, Config0),
- Dir = filename:join(PrivDir, random_chars(10)),
+ Dir = filename:join(PrivDir, ssh_test_lib:random_chars(10)),
file:make_dir(Dir),
Keys = [filename,
testfile,
@@ -1058,8 +1058,6 @@ prepare(Config0) ->
[{sftp_priv_dir,Dir} | Config2].
-random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
-
foldl_keydelete(Keys, L) ->
lists:foldl(fun(K,E) -> lists:keydelete(K,1,E) end,
L,
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index f93237f3e7..286ac6e882 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -113,19 +113,27 @@ std_simple_exec(Host, Port, Config) ->
std_simple_exec(Host, Port, Config, []).
std_simple_exec(Host, Port, Config, Opts) ->
+ ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]),
ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts),
+ ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]),
{ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
- success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity),
- Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}},
- case ssh_test_lib:receive_exec_result(Data) of
- expected ->
- ok;
- Other ->
- ct:fail(Other)
- end,
- ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId),
- ssh:close(ConnectionRef).
-
+ ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]),
+ ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity),
+ ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]),
+ case ExecResult of
+ success ->
+ Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42\n">>}},
+ case receive_exec_result(Expected) of
+ expected ->
+ ok;
+ Other ->
+ ct:fail(Other)
+ end,
+ receive_exec_end(ConnectionRef, ChannelId),
+ ssh:close(ConnectionRef);
+ _ ->
+ ct:fail(ExecResult)
+ end.
start_shell(Port, IOServer) ->
start_shell(Port, IOServer, []).
@@ -834,3 +842,20 @@ get_kex_init(Conn, Ref, TRef) ->
end
end.
+%%%----------------------------------------------------------------
+%%% Return a string with N random characters
+%%%
+random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
+
+
+create_random_dir(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Name = filename:join(PrivDir, random_chars(15)),
+ case file:make_dir(Name) of
+ ok ->
+ Name;
+ {error,eexist} ->
+ %% The Name already denotes an existing file system object, try again.
+ %% The likelyhood of always generating an existing file name is low
+ create_random_dir(Config)
+ end.
diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl
index b5b27c369a..7b9b109fa1 100644
--- a/lib/ssh/test/ssh_upgrade_SUITE.erl
+++ b/lib/ssh/test/ssh_upgrade_SUITE.erl
@@ -199,6 +199,4 @@ close(#state{server = Server,
connection = undefined}.
-random_contents() -> list_to_binary( random_chars(3) ).
-
-random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
+random_contents() -> list_to_binary( ssh_test_lib:random_chars(3) ).
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index edc7e0d8b2..916b41742e 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid
</taglist>
</item>
+
+ <tag><c>max_handshake_size</c></tag>
+ <item>
+ <p>Integer (24 bits unsigned). Used to limit the size of
+ valid TLS handshake packets to avoid DoS attacks.
+ Defaults to 256*1024.</p>
+ </item>
+
</taglist>
</item>
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index c72ee44a95..0b7229b67e 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -765,7 +765,8 @@ handle_options(Opts0, Role) ->
client, Role),
crl_check = handle_option(crl_check, Opts, false),
crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}),
- v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false)
+ v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false),
+ max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE)
},
CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)),
@@ -780,7 +781,8 @@ handle_options(Opts0, Role) ->
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, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible],
+ fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible,
+ max_handshake_size],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
@@ -1028,6 +1030,8 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse
Value;
validate_option(v2_hello_compatible, Value) when is_boolean(Value) ->
Value;
+validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {options, {Opt, Value}}}).
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 6e7c8c5ddd..6ed2fc83da 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -864,11 +864,11 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i
%% When downgrading an TLS connection to a transport connection
%% we must recive the close alert from the peer before releasing the
%% transport socket.
- {next_state, downgrade, State, [{timeout, Timeout, downgrade}]};
+ {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]};
handle_call({close, _} = Close, From, StateName, State, Connection) ->
%% Run terminate before returning so that the reuseaddr
- %% inet-option
- Result = Connection:terminate(Close, StateName, State),
+ %% inet-option works properly
+ Result = Connection:terminate(Close, StateName, State#state{terminated = true}),
{stop_and_reply, {shutdown, normal},
{reply, From, Result}, State};
handle_call({shutdown, How0}, From, _,
@@ -1010,7 +1010,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) ->
terminate(_, _, #state{terminated = true}) ->
%% Happens when user closes the connection using ssl:close/1
%% we want to guarantee that Transport:close has been called
- %% when ssl:close/1 returns.
+ %% when ssl:close/1 returns unless it is a downgrade where
+ %% we want to guarantee that close alert is recived before
+ %% returning. In both cases terminate has been run manually
+ %% before run by gen_statem which will end up here
ok;
terminate({shutdown, transport_closed} = Reason,
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index fde92035a2..324b7dbde3 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -80,6 +80,9 @@
-define(CLIENT_KEY_EXCHANGE, 16).
-define(FINISHED, 20).
+-define(MAX_UNIT24, 8388607).
+-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)).
+
-record(random, {
gmt_unix_time, % uint32
random_bytes % opaque random_bytes[28]
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 98b89bb811..c34af9f82c 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -142,7 +142,8 @@
signature_algs,
eccs,
honor_ecc_order :: boolean(),
- v2_hello_compatible :: boolean()
+ v2_hello_compatible :: boolean(),
+ max_handshake_size :: integer()
}).
-record(socket_options,
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 32991d3079..77606911be 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -424,18 +424,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
ssl_options = Options} = State0) ->
try
{Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options),
- State =
+ State1 =
State0#state{protocol_buffers =
Buffers#protocol_buffers{tls_handshake_buffer = Buf}},
- Events = tls_handshake_events(Packets),
- case StateName of
- connection ->
- ssl_connection:hibernate_after(StateName, State, Events);
- _ ->
- {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
- end
+ case Packets of
+ [] ->
+ assert_buffer_sanity(Buf, Options),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State);
+ _ ->
+ Events = tls_handshake_events(Packets),
+ case StateName of
+ connection ->
+ ssl_connection:hibernate_after(StateName, State1, Events);
+ _ ->
+ {next_state, StateName,
+ State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
+ end
+ end
catch throw:#alert{} = Alert ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
end;
%%% TLS record protocol level application data messages
handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
@@ -615,8 +623,6 @@ next_event(StateName, Record, State, Actions) ->
{next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
end.
-tls_handshake_events([]) ->
- throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake));
tls_handshake_events(Packets) ->
lists:map(fun(Packet) ->
{next_event, internal, {handshake, Packet}}
@@ -735,3 +741,25 @@ unprocessed_events(Events) ->
%% handshake events left to process before we should
%% process more TLS-records received on the socket.
erlang:length(Events)-1.
+
+
+assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when
+ Length =< Max ->
+ case size(Rest) of
+ N when N < Length ->
+ true;
+ N when N > Length ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ too_big_handshake_data));
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data))
+ end;
+assert_buffer_sanity(Bin, _) ->
+ case size(Bin) of
+ N when N < 3 ->
+ true;
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data))
+ end.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 52c1af5b4c..de5895d7ba 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -136,7 +136,8 @@ options_tests() ->
honor_server_cipher_order,
honor_client_cipher_order,
unordered_protocol_versions_server,
- unordered_protocol_versions_client
+ unordered_protocol_versions_client,
+ max_handshake_size
].
options_tests_tls() ->
@@ -3860,6 +3861,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
%%--------------------------------------------------------------------
+max_handshake_size() ->
+ [{doc,"Test that we can set max_handshake_size to max value."}].
+
+max_handshake_size(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{max_handshake_size, 8388607} |ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{max_handshake_size, 8388607} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+%%--------------------------------------------------------------------
server_name_indication_option() ->
[{doc,"Test API server_name_indication option to connect."}].
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 40a34aa30f..eafee346eb 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1306,6 +1306,7 @@ partial_eval(Expr) ->
ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R));
ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A));
ev_expr({integer,_,X}) -> X;
+ev_expr({char,_,X}) -> X;
ev_expr({float,_,X}) -> X;
ev_expr({atom,_,X}) -> X;
ev_expr({tuple,_,Es}) ->
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 4f38256e6b..d2dd2848b5 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -156,6 +156,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'),
record, ['$2'|'$4']}.
type -> binary_type : '$1'.
type -> integer : '$1'.
+type -> char : '$1'.
type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}.
type -> 'fun' '(' fun_type_100 ')' : '$3'.
@@ -1557,13 +1558,17 @@ new_anno(Term) ->
Abstr :: erl_parse_tree().
anno_to_term(Abstract) ->
- map_anno(fun erl_anno:to_term/1, Abstract).
+ F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end,
+ {NewAbstract, []} = modify_anno1(Abstract, [], F),
+ NewAbstract.
-spec anno_from_term(Term) -> erl_parse_tree() when
Term :: term().
anno_from_term(Term) ->
- map_anno(fun erl_anno:from_term/1, Term).
+ F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end,
+ {NewTerm, []} = modify_anno1(Term, [], F),
+ NewTerm.
%% Forms.
%% Recognize what sys_pre_expand does:
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 7f5ef4df42..c42ae981e7 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) ->
%% Look for special comment on second line
Line2 = get_line(Fd),
{ok, HeaderSz2} = file:position(Fd, cur),
- case classify_line(Line2) of
- emu_args ->
- %% Skip special comment on second line
- Line3 = get_line(Fd),
- {HeaderSz2, LineNo + 2, Fd,
- Sections#sections{type = guess_type(Line3),
- comment = undefined,
- emu_args = Line2}};
- Line2Type ->
- %% Look for special comment on third line
- Line3 = get_line(Fd),
- {ok, HeaderSz3} = file:position(Fd, cur),
- Line3Type = classify_line(Line3),
- if
- Line3Type =:= emu_args ->
- %% Skip special comment on third line
- Line4 = get_line(Fd),
- {HeaderSz3, LineNo + 3, Fd,
- Sections#sections{type = guess_type(Line4),
- comment = Line2,
- emu_args = Line3}};
- Sections#sections.shebang =:= undefined,
- KeepFirst =:= true ->
- %% No shebang. Use the entire file
- {HeaderSz0, LineNo, Fd,
- Sections#sections{type = guess_type(Line2)}};
- Sections#sections.shebang =:= undefined ->
- %% No shebang. Skip the first line
- {HeaderSz1, LineNo, Fd,
- Sections#sections{type = guess_type(Line2)}};
- Line2Type =:= comment ->
- %% Skip shebang on first line and comment on second
- {HeaderSz2, LineNo + 2, Fd,
- Sections#sections{type = guess_type(Line3),
- comment = Line2}};
- true ->
- %% Just skip shebang on first line
- {HeaderSz1, LineNo + 1, Fd,
- Sections#sections{type = guess_type(Line2)}}
- end
+ if
+ Sections#sections.shebang =:= undefined,
+ KeepFirst =:= true ->
+ %% No shebang. Use the entire file
+ {HeaderSz0, LineNo, Fd,
+ Sections#sections{type = guess_type(Line2)}};
+ Sections#sections.shebang =:= undefined ->
+ %% No shebang. Skip the first line
+ {HeaderSz1, LineNo, Fd,
+ Sections#sections{type = guess_type(Line2)}};
+ true ->
+ case classify_line(Line2) of
+ emu_args ->
+ %% Skip special comment on second line
+ Line3 = get_line(Fd),
+ {HeaderSz2, LineNo + 2, Fd,
+ Sections#sections{type = guess_type(Line3),
+ comment = undefined,
+ emu_args = Line2}};
+ comment ->
+ %% Look for special comment on third line
+ Line3 = get_line(Fd),
+ {ok, HeaderSz3} = file:position(Fd, cur),
+ Line3Type = classify_line(Line3),
+ if
+ Line3Type =:= emu_args ->
+ %% Skip special comment on third line
+ Line4 = get_line(Fd),
+ {HeaderSz3, LineNo + 3, Fd,
+ Sections#sections{type = guess_type(Line4),
+ comment = Line2,
+ emu_args = Line3}};
+ true ->
+ %% Skip shebang on first line and comment on second
+ {HeaderSz2, LineNo + 2, Fd,
+ Sections#sections{type = guess_type(Line3),
+ comment = Line2}}
+ end;
+ _ ->
+ %% Just skip shebang on first line
+ {HeaderSz1, LineNo + 1, Fd,
+ Sections#sections{type = guess_type(Line2)}}
+ end
end.
classify_line(Line) ->
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 28d69232a0..0b9106a99c 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -28,6 +28,7 @@
strange_name/1,
emulator_flags/1,
emulator_flags_no_shebang/1,
+ two_lines/1,
module_script/1,
beam_script/1,
archive_script/1,
@@ -49,7 +50,7 @@ suite() ->
all() ->
[basic, errors, strange_name, emulator_flags,
- emulator_flags_no_shebang,
+ emulator_flags_no_shebang, two_lines,
module_script, beam_script, archive_script, epp,
create_and_extract, foldl, overflow,
archive_script_file_access, unicode].
@@ -153,6 +154,18 @@ emulator_flags(Config) when is_list(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+two_lines(Config) when is_list(Config) ->
+ Data = proplists:get_value(data_dir, Config),
+ Dir = filename:absname(Data), %Get rid of trailing slash.
+ run(Dir, "two_lines -arg1 arg2 arg3",
+ [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n"
+ "ERL_FLAGS=false\n"
+ "unknown:[]\n"
+ "ExitCode:0">>]),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
emulator_flags_no_shebang(Config) when is_list(Config) ->
Data = proplists:get_value(data_dir, Config),
Dir = filename:absname(Data), %Get rid of trailing slash.
diff --git a/lib/stdlib/test/escript_SUITE_data/two_lines b/lib/stdlib/test/escript_SUITE_data/two_lines
new file mode 100755
index 0000000000..cf4e99639c
--- /dev/null
+++ b/lib/stdlib/test/escript_SUITE_data/two_lines
@@ -0,0 +1,2 @@
+#! /usr/bin/env escript
+main(MainArgs) -> io:format("main:~p\n", [MainArgs]), ErlArgs = init:get_arguments(), io:format("ERL_FLAGS=~p\n", [os:getenv("ERL_FLAGS")]), io:format("unknown:~p\n",[[E || E <- ErlArgs, element(1, E) =:= unknown]]).
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 02b7cb10c2..47e7c4f03d 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -275,13 +275,13 @@ gen(_, _, Acc) -> lists:reverse(Acc).
%% Check that the algorithms generate sound values.
basic_stats_uniform_1(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
basic_stats_uniform_2(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
@@ -388,7 +388,7 @@ crypto_uniform_n(N, State0) ->
%% Not a test but measures the time characteristics of the different algorithms
measure(Suite) when is_atom(Suite) -> [];
measure(_Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
Algos = [crypto64|algs()],
io:format("RNG uniform integer performance~n",[]),
_ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end),
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index c409a6949b..80585ca359 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -2325,7 +2325,7 @@ otp_6554(Config) when is_list(Config) ->
"[unproper | list]).">>),
%% Cheating:
"exception error: no function clause matching "
- "erl_eval:do_apply(4)" ++ _ =
+ "shell:apply_fun(4)" ++ _ =
comm_err(<<"erlang:error(function_clause, [4]).">>),
"exception error: no function clause matching "
"lists:reverse(" ++ _ =
diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl
index 5c82750a21..cd67af41ed 100644
--- a/lib/typer/src/typer.erl
+++ b/lib/typer/src/typer.erl
@@ -143,8 +143,9 @@ extract(#analysis{macros = Macros,
MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords),
CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1),
CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2),
- CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3),
- dialyzer_contracts:process_contract_remote_types(CodeServer4)
+ {CodeServer4, RecordDict} =
+ dialyzer_utils:process_record_remote_types(CodeServer3),
+ dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict)
catch
throw:{error, ErrorMsg} ->
compile_error(ErrorMsg)
@@ -156,7 +157,7 @@ extract(#analysis{macros = Macros,
fun(Module, TmpPlt) ->
{ok, ModuleContracts} = dict:find(Module, Contracts),
SpecList = [{MFA, Contract}
- || {MFA, {_FileLine, Contract}} <- dict:to_list(ModuleContracts)],
+ || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)],
dialyzer_plt:insert_contract_list(TmpPlt, SpecList)
end,
NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules),
@@ -172,8 +173,10 @@ get_type_info(#analysis{callgraph = CallGraph,
StrippedCallGraph = remove_external(CallGraph, TrustPLT),
%% io:format("--- Analyzing callgraph... "),
try
- NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
- TrustPLT, CodeServer),
+ NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
+ TrustPLT,
+ CodeServer),
+ NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt),
Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt}
catch
error:What ->
@@ -224,7 +227,7 @@ get_external(Exts, Plt) ->
-type fa() :: {atom(), arity()}.
-type func_info() :: {line(), atom(), arity()}.
--record(info, {records = map__new() :: map_dict(),
+-record(info, {records = maps:new() :: erl_types:type_table(),
functions = [] :: [func_info()],
types = map__new() :: map_dict(),
edoc = false :: boolean()}).
@@ -267,7 +270,7 @@ write_inc_files(Inc) ->
Functions = [Key || {Key, _} <- Val],
Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val],
Info = #info{types = map__from_list(Val1),
- records = map__new(),
+ records = maps:new(),
%% Note we need to sort functions here!
functions = lists:keysort(1, Functions)},
%% io:format("Types ~p\n", [Info#info.types]),
@@ -849,8 +852,9 @@ collect_info(Analysis) ->
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer),
TmpCServer2 =
dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
- TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
- dialyzer_contracts:process_contract_remote_types(TmpCServer3)
+ {TmpCServer3, RecordDict} =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict)
catch
throw:{error, ErrorMsg} ->
fatal_error(ErrorMsg)
diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl
index 5e0459ec21..9f6b27113e 100644
--- a/lib/xmerl/src/xmerl_scan.erl
+++ b/lib/xmerl/src/xmerl_scan.erl
@@ -2225,16 +2225,18 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook,
AllAttrs =
case S#xmerl_scanner.default_attrs of
true ->
- [ #xmlAttribute{name = AttName,
- parents = [{Name, Pos} | Parents],
- language = Lang,
- nsinfo = NSI,
- namespace = Namespace,
- value = AttValue,
- normalized = true} ||
- {AttName, AttValue} <- get_default_attrs(S, Name),
- AttValue =/= no_value,
- not lists:keymember(AttName, #xmlAttribute.name, Attrs) ];
+ DefaultAttrs =
+ [ #xmlAttribute{name = AttName,
+ parents = [{Name, Pos} | Parents],
+ language = Lang,
+ nsinfo = NSI,
+ namespace = Namespace,
+ value = AttValue,
+ normalized = true} ||
+ {AttName, AttValue} <- get_default_attrs(S, Name),
+ AttValue =/= no_value,
+ not lists:keymember(AttName, #xmlAttribute.name, Attrs) ],
+ lists:append(Attrs, DefaultAttrs);
false ->
Attrs
end,
diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl
index e97b8c6a4b..cf7c0b7548 100644
--- a/lib/xmerl/test/xmerl_SUITE.erl
+++ b/lib/xmerl/test/xmerl_SUITE.erl
@@ -54,7 +54,8 @@ groups() ->
cpd_expl_provided_DTD]},
{misc, [],
[latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3,
- pe_ref1, copyright, testXSEIF, export_simple1, export]},
+ pe_ref1, copyright, testXSEIF, export_simple1, export,
+ default_attrs_bug]},
{eventp_tests, [], [sax_parse_and_export]},
{ticket_tests, [],
[ticket_5998, ticket_7211, ticket_7214, ticket_7430,
@@ -223,6 +224,21 @@ syntax_bug3(Config) ->
Err -> Err
end.
+default_attrs_bug(Config) ->
+ file:set_cwd(datadir(Config)),
+ Doc = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n"
+ "<doc a=\"explicit\"/>",
+ {#xmlElement{attributes = [#xmlAttribute{name = a, value = "explicit"},
+ #xmlAttribute{name = b, value = "default"}]},
+ []
+ } = xmerl_scan:string(Doc, [{default_attrs, true}]),
+ Doc2 = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n"
+ "<doc b=\"also explicit\" a=\"explicit\"/>",
+ {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"},
+ #xmlAttribute{name = a, value = "explicit"}]},
+ []
+ } = xmerl_scan:string(Doc2, [{default_attrs, true}]).
+
pe_ref1(Config) ->
file:set_cwd(datadir(Config)),
{#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]).