aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el9
-rw-r--r--.travis.yml10
-rw-r--r--CONTRIBUTING.md98
-rw-r--r--OTP_VERSION2
-rw-r--r--README.md2
-rw-r--r--erts/aclocal.m434
-rw-r--r--erts/doc/src/erl.xml19
-rw-r--r--erts/doc/src/erl_driver.xml15
-rw-r--r--erts/doc/src/erlang.xml12
-rw-r--r--erts/doc/src/notes.xml54
-rw-r--r--erts/doc/src/zlib.xml9
-rw-r--r--erts/emulator/beam/beam_bif_load.c27
-rw-r--r--erts/emulator/beam/beam_bp.c78
-rw-r--r--erts/emulator/beam/beam_bp.h12
-rw-r--r--erts/emulator/beam/beam_emu.c241
-rw-r--r--erts/emulator/beam/beam_load.c15
-rw-r--r--erts/emulator/beam/break.c52
-rw-r--r--erts/emulator/beam/copy.c12
-rw-r--r--erts/emulator/beam/dist.c4
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c22
-rw-r--r--erts/emulator/beam/erl_bif_guard.c5
-rw-r--r--erts/emulator/beam/erl_bif_info.c6
-rw-r--r--erts/emulator/beam/erl_bif_trace.c7
-rw-r--r--erts/emulator/beam/erl_db.c20
-rw-r--r--erts/emulator/beam/erl_db_util.c2
-rw-r--r--erts/emulator/beam/erl_db_util.h4
-rw-r--r--erts/emulator/beam/erl_fun.c20
-rw-r--r--erts/emulator/beam/erl_fun.h2
-rw-r--r--erts/emulator/beam/erl_gc.c212
-rw-r--r--erts/emulator/beam/erl_gc.h5
-rw-r--r--erts/emulator/beam/erl_hl_timer.c5
-rw-r--r--erts/emulator/beam/erl_init.c6
-rw-r--r--erts/emulator/beam/erl_lock_check.c2
-rw-r--r--erts/emulator/beam/erl_message.c4
-rw-r--r--erts/emulator/beam/erl_monitors.c2
-rw-r--r--erts/emulator/beam/erl_nif.c6
-rw-r--r--erts/emulator/beam/erl_node_tables.c50
-rw-r--r--erts/emulator/beam/erl_node_tables.h8
-rw-r--r--erts/emulator/beam/erl_process.c262
-rw-r--r--erts/emulator/beam/erl_process.h2
-rw-r--r--erts/emulator/beam/erl_process_dump.c5
-rw-r--r--erts/emulator/beam/erl_trace.c5
-rw-r--r--erts/emulator/beam/erl_vm.h17
-rw-r--r--erts/emulator/beam/export.c2
-rw-r--r--erts/emulator/beam/external.c27
-rw-r--r--erts/emulator/beam/global.h2
-rw-r--r--erts/emulator/beam/index.c9
-rw-r--r--erts/emulator/beam/index.h14
-rw-r--r--erts/emulator/beam/io.c47
-rw-r--r--erts/emulator/beam/sys.h131
-rw-r--r--erts/emulator/beam/utils.c2
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c89
-rw-r--r--erts/emulator/hipe/hipe_bif0.c2
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c12
-rw-r--r--erts/emulator/sys/unix/sys.c43
-rw-r--r--erts/emulator/test/Makefile1
-rw-r--r--erts/emulator/test/bif_SUITE.erl173
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl6
-rw-r--r--erts/emulator/test/code_SUITE.erl2
-rw-r--r--erts/emulator/test/emulator_smoke.spec12
-rw-r--r--erts/emulator/test/guard_SUITE.erl1
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl3
-rw-r--r--erts/emulator/test/port_SUITE.erl2
-rw-r--r--erts/emulator/test/port_SUITE_data/Makefile.src6
-rw-r--r--erts/emulator/test/port_SUITE_data/port_test.c16
-rw-r--r--erts/emulator/test/port_trace_SUITE_data/echo_drv.c39
-rw-r--r--erts/emulator/test/prim_eval_SUITE.erl78
-rw-r--r--erts/emulator/test/process_SUITE.erl21
-rw-r--r--erts/etc/common/heart.c40
-rw-r--r--erts/etc/unix/etp-commands.in12
-rw-r--r--erts/lib_src/common/ethr_aux.c2
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1300 -> 1448 bytes
-rw-r--r--erts/preloaded/src/prim_eval.S41
-rw-r--r--erts/test/install_SUITE.erl44
-rw-r--r--erts/test/system_smoke.spec7
-rw-r--r--erts/test/upgrade_SUITE.erl4
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/common_test/doc/src/Makefile3
-rw-r--r--lib/common_test/doc/src/common_test_app.xml26
-rw-r--r--lib/common_test/doc/src/ct_hooks.xml90
-rw-r--r--lib/common_test/doc/src/ct_hooks_chapter.xml74
-rw-r--r--lib/common_test/doc/src/ct_testspec.xml84
-rw-r--r--lib/common_test/doc/src/ref_man.xml1
-rw-r--r--lib/common_test/doc/src/write_test_chapter.xml2
-rw-r--r--lib/common_test/src/common_test.app.src1
-rw-r--r--lib/common_test/src/ct_framework.erl161
-rw-r--r--lib/common_test/src/ct_groups.erl14
-rw-r--r--lib/common_test/src/ct_hooks.erl141
-rw-r--r--lib/common_test/src/ct_run.erl27
-rw-r--r--lib/common_test/src/ct_testspec.erl35
-rw-r--r--lib/common_test/src/cth_conn_log.erl8
-rw-r--r--lib/common_test/src/cth_log_redirect.erl28
-rw-r--r--lib/common_test/src/cth_surefire.erl54
-rw-r--r--lib/common_test/src/test_server.erl10
-rw-r--r--lib/common_test/src/test_server_ctrl.erl116
-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_error_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl1201
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl62
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl43
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl51
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl54
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl39
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl122
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl32
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl81
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl6
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl42
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl45
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec8
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl106
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl182
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl64
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl79
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl40
-rw-r--r--lib/common_test/test/ct_repeat_testrun_SUITE.erl5
-rw-r--r--lib/common_test/test/ct_surefire_SUITE.erl129
-rw-r--r--lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec2
-rw-r--r--lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec2
-rw-r--r--lib/common_test/test/ct_test_server_if_1_SUITE.erl1
-rw-r--r--lib/common_test/test/ct_test_support.erl24
-rw-r--r--lib/common_test/test/ct_testspec_2_SUITE.erl82
-rw-r--r--lib/compiler/doc/src/compile.xml2
-rw-r--r--lib/compiler/src/compile.erl30
-rw-r--r--lib/compiler/test/lc_SUITE.erl9
-rw-r--r--lib/crypto/c_src/crypto.c18
-rw-r--r--lib/crypto/doc/src/crypto.xml2
-rw-r--r--lib/crypto/src/crypto.erl23
-rw-r--r--lib/dialyzer/src/dialyzer.app.src4
-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.erl40
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl3
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl138
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl33
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl99
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl118
-rw-r--r--lib/dialyzer/test/abstract_SUITE.erl6
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options2
-rw-r--r--lib/dialyzer/test/map_SUITE_data/dialyzer_options1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/dialyzer_options2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/weird6
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl18
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl14
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl19
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl23
-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/erl_interface/doc/src/erl_call.xml2
-rw-r--r--lib/hipe/cerl/erl_types.erl239
-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/doc/src/notes.xml17
-rw-r--r--lib/inets/src/ftp/ftp.erl53
-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/src/http_server/httpd_request_handler.erl4
-rw-r--r--lib/inets/src/inets_app/inets.appup.src4
-rw-r--r--lib/inets/test/httpc_SUITE.erl71
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/heart.xml17
-rw-r--r--lib/kernel/src/error_logger.erl8
-rw-r--r--lib/kernel/src/file.erl2
-rw-r--r--lib/kernel/src/heart.erl15
-rw-r--r--lib/kernel/src/os.erl24
-rw-r--r--lib/kernel/src/rpc.erl14
-rw-r--r--lib/kernel/test/code_SUITE.erl36
-rw-r--r--lib/kernel/test/error_logger_SUITE.erl13
-rw-r--r--lib/kernel/test/rpc_SUITE.erl12
-rw-r--r--lib/mnesia/doc/src/notes.xml18
-rw-r--r--lib/mnesia/src/mnesia_checkpoint.erl7
-rw-r--r--lib/mnesia/src/mnesia_event.erl3
-rw-r--r--lib/mnesia/test/mnesia_evil_backup.erl43
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/observer/src/cdv_bin_cb.erl2
-rw-r--r--lib/observer/src/cdv_detail_wx.erl2
-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_app_wx.erl8
-rw-r--r--lib/observer/src/observer_lib.erl26
-rw-r--r--lib/observer/src/observer_port_wx.erl27
-rw-r--r--lib/observer/src/observer_pro_wx.erl8
-rw-r--r--lib/observer/src/observer_procinfo.erl2
-rw-r--r--lib/observer/src/observer_tv_wx.erl9
-rw-r--r--lib/observer/src/observer_wx.erl10
-rw-r--r--lib/observer/test/observer_SUITE.erl17
-rw-r--r--lib/os_mon/src/memsup.erl1
-rw-r--r--lib/public_key/doc/src/public_key.xml38
-rw-r--r--lib/public_key/doc/src/using_public_key.xml253
-rw-r--r--lib/public_key/src/public_key.erl190
-rw-r--r--lib/public_key/test/public_key_SUITE.erl145
-rw-r--r--lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem17
-rw-r--r--lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem14
-rw-r--r--lib/public_key/test/public_key_SUITE_data/verify_hostname.conf16
-rw-r--r--lib/runtime_tools/doc/src/LTTng.xml2
-rw-r--r--lib/runtime_tools/src/observer_backend.erl7
-rw-r--r--lib/sasl/doc/src/systools.xml6
-rw-r--r--lib/sasl/src/systools_make.erl168
-rw-r--r--lib/sasl/src/systools_relup.erl150
-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/sasl/test/systools_SUITE.erl116
-rw-r--r--lib/snmp/src/app/snmp.appup.src8
-rw-r--r--lib/snmp/src/app/snmp.erl80
-rw-r--r--lib/snmp/src/compile/snmpc_lib.erl4
-rw-r--r--lib/snmp/src/compile/snmpc_mib_gram.yrl6
-rw-r--r--lib/snmp/test/snmp_compiler_test.erl32
-rw-r--r--lib/snmp/test/snmp_test_data/OTP14145-MIB.mib44
-rw-r--r--lib/snmp/vsn.mk4
-rw-r--r--lib/ssh/doc/src/ssh.xml58
-rw-r--r--lib/ssh/doc/src/using_ssh.xml2
-rw-r--r--lib/ssh/src/ssh.app.src1
-rw-r--r--lib/ssh/src/ssh.erl47
-rw-r--r--lib/ssh/src/ssh_auth.erl6
-rw-r--r--lib/ssh/src/ssh_cli.erl18
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl15
-rw-r--r--lib/ssh/src/ssh_dbg.erl66
-rw-r--r--lib/ssh/src/ssh_sftpd.erl55
-rw-r--r--lib/ssh/src/ssh_sftpd_file_api.erl2
-rw-r--r--lib/ssh/src/ssh_transport.erl125
-rw-r--r--lib/ssh/test/property_test/ssh_eqc_encode_decode.erl370
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl30
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE.erl2
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl37
-rw-r--r--lib/ssh/test/ssh_property_test_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl41
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test4
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli5
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE.erl4
-rw-r--r--lib/ssh/test/ssh_sftpd_SUITE.erl161
-rw-r--r--lib/ssh/test/ssh_test_lib.erl54
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE.erl4
-rw-r--r--lib/ssl/doc/src/ssl.xml8
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml29
-rw-r--r--lib/ssl/src/Makefile15
-rw-r--r--lib/ssl/src/dtls_connection.erl139
-rw-r--r--lib/ssl/src/dtls_handshake.erl8
-rw-r--r--lib/ssl/src/dtls_socket.erl13
-rw-r--r--lib/ssl/src/dtls_udp_listener.erl62
-rw-r--r--lib/ssl/src/dtls_v1.erl15
-rw-r--r--lib/ssl/src/ssl.app.src15
-rw-r--r--lib/ssl/src/ssl.appup.src18
-rw-r--r--lib/ssl/src/ssl.erl107
-rw-r--r--lib/ssl/src/ssl_admin_sup.erl95
-rw-r--r--lib/ssl/src/ssl_certificate.erl16
-rw-r--r--lib/ssl/src/ssl_cipher.erl22
-rw-r--r--lib/ssl/src/ssl_config.erl52
-rw-r--r--lib/ssl/src/ssl_connection.erl98
-rw-r--r--lib/ssl/src/ssl_connection_sup.erl101
-rw-r--r--lib/ssl/src/ssl_crl.erl76
-rw-r--r--lib/ssl/src/ssl_dist_admin_sup.erl74
-rw-r--r--lib/ssl/src/ssl_dist_connection_sup.erl79
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl42
-rw-r--r--lib/ssl/src/ssl_handshake.erl58
-rw-r--r--lib/ssl/src/ssl_handshake.hrl3
-rw-r--r--lib/ssl/src/ssl_internal.hrl5
-rw-r--r--lib/ssl/src/ssl_manager.erl209
-rw-r--r--lib/ssl/src/ssl_pem_cache.erl266
-rw-r--r--lib/ssl/src/ssl_pkix_db.erl72
-rw-r--r--lib/ssl/src/ssl_sup.erl86
-rw-r--r--lib/ssl/src/tls_connection.erl65
-rw-r--r--lib/ssl/src/tls_handshake.erl67
-rw-r--r--lib/ssl/src/tls_v1.erl18
-rw-r--r--lib/ssl/test/make_certs.erl4
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl143
-rw-r--r--lib/ssl/test/ssl_certificate_verify_SUITE.erl62
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl9
-rw-r--r--lib/ssl/test/ssl_npn_hello_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_pem_cache_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_test_lib.erl243
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl57
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/filename.xml27
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml167
-rw-r--r--lib/stdlib/doc/src/sys.xml4
-rw-r--r--lib/stdlib/src/edlin_expand.erl95
-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/src/filename.erl36
-rw-r--r--lib/stdlib/src/gen_event.erl2
-rw-r--r--lib/stdlib/src/gen_statem.erl867
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl131
-rw-r--r--lib/stdlib/src/qlc.erl6
-rw-r--r--lib/stdlib/src/zip.erl62
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl79
-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/filename_SUITE.erl69
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl105
-rw-r--r--lib/stdlib/test/io_SUITE.erl241
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl18
-rw-r--r--lib/stdlib/test/rand_SUITE.erl6
-rw-r--r--lib/stdlib/test/shell_SUITE.erl2
-rw-r--r--lib/stdlib/test/zip_SUITE.erl36
-rw-r--r--lib/tools/emacs/erlang-edoc.el6
-rw-r--r--lib/tools/emacs/erlang-skels.el14
-rw-r--r--lib/tools/examples/xref_examples.erl2
-rw-r--r--lib/typer/src/typer.app.src4
-rw-r--r--lib/typer/src/typer.erl22
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.erl33
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.hrl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc144
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc38
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_list.erlsrc19
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_scan.erl31
-rw-r--r--lib/xmerl/test/Makefile4
-rw-r--r--lib/xmerl/test/xmerl_SUITE.erl47
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl6
-rw-r--r--lib/xmerl/test/xmerl_sax_std_SUITE.erl100
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE.erl245
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml17
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml18
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml34
-rwxr-xr-xotp_build35
-rw-r--r--otp_versions.table4
-rwxr-xr-xscripts/build-otp39
-rwxr-xr-xscripts/run-smoke-tests10
-rw-r--r--system/doc/design_principles/statem.xml15
-rw-r--r--system/doc/efficiency_guide/advanced.xml12
-rw-r--r--system/doc/reference_manual/typespec.xml89
-rw-r--r--system/doc/tutorial/c_portdriver.xmlsrc4
352 files changed, 12345 insertions, 5045 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000000..17bf4b636c
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,9 @@
+;; Project-wide Emacs settings
+(
+ ;; `nil' settings apply to all language modes
+ (nil
+ ;; Use only spaces for indentation
+ (indent-tabs-mode . nil))
+ (c-mode
+ ;; In C code, indentation is four spaces
+ (c-basic-offset . 4)))
diff --git a/.travis.yml b/.travis.yml
index 43bf0c7fb5..baa55b383d 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -29,15 +29,13 @@ before_script:
- kerl_deactivate
script:
- - ./otp_build all -a
+ - ./scripts/build-otp
after_success:
- $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics
- - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib --statistics
- - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps asn1 crypto dialyzer --statistics
- - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps hipe parsetools public_key --statistics
- - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps runtime_tools sasl tools --statistics
+ - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics
+ - $ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools tools wx xmerl --statistics
- ./otp_build tests && make release_docs
after_script:
- - cd $ERL_TOP/release/tests/test_server && $ERL_TOP/bin/erl -s ts install -s ts smoke_test batch -s init stop
+ - ./scripts/run-smoke-tests
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
new file mode 100644
index 0000000000..328b9f7859
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,98 @@
+# Contributing to Erlang/OTP
+
+## Reporting a bug
+
+Report bugs at https://bugs.erlang.org. See [Bug reports](https://github.com/erlang/otp/wiki/Bug-reports)
+for more information.
+
+## Submitting Pull Requests
+
+You can contribute to Erlang/OTP by opening a Pull Request.
+
+## Fixing a bug
+
+* In most cases, pull requests for bug fixes should be based on the `maint` branch.
+There are exceptions, for example corrections to bugs that have been introduced in the `master` branch.
+
+* Include a test case to ensure that the bug is fixed **and that it stays fixed**.
+
+* TIP: Write the test case **before** fixing the bug so that you can know that it catches the bug.
+
+* For applications without a test suite in the git repository, it would be appreciated if you provide a
+small code sample in the commit message or email a module that will provoke the failure.
+
+## Adding a new feature
+
+* In most cases, pull requests for new features should be based on the `master` branch.
+
+* It is recommended to discuss new features on
+[the erlang-questions mailing list](http://erlang.org/mailman/listinfo/erlang-questions),
+especially for major new features or any new features in ERTS, Kernel, or STDLIB.
+
+* It is important to write a good commit message explaining **why** the feature is needed.
+We prefer that the information is in the commit message, so that anyone that want to know
+two years later why a particular feature can easily find out. It does no harm to provide
+the same information in the pull request (if the pull request consists of a single commit,
+the commit message will be added to the pull request automatically).
+
+* With few exceptions, it is mandatory to write a new test case that tests the feature.
+The test case is needed to ensure that the features does not stop working in the future.
+
+* Update the [Documentation](https://github.com/erlang/otp/wiki/Documentation) to describe the feature.
+
+* Make sure that the new feature builds and works on all major platforms. Exceptions are features
+that only makes sense one some platforms, for example the `win32reg` module for accessing the Windows registry.
+
+* Make sure that your feature does not break backward compatibility. In general, we only break backward
+compatibility in major releases and only for a very good reason. Usually we first deprecate the
+feature one or two releases beforehand.
+
+* In general, language changes/extensions require an
+[EEP (Erlang Enhancement Proposal)](https://github.com/erlang/eep) to be written and approved before they
+can be included in OTP. Major changes or new features in ERTS, Kernel, or STDLIB will need an EEP or at least
+a discussion on the mailing list.
+
+## Before you submit your pull request
+
+* Make sure existing test cases don't fail. It is not necessary to run all tests (that would take many hours),
+but you should at least run the tests for the application you have changed.
+See [Running tests](https://github.com/erlang/otp/wiki/Running-tests).
+
+Make sure that your branch contains clean commits:
+
+* Don't make the first line in the commit message longer than 72 characters.
+**Don't end the first line with a period.**
+
+* Follow the guidelines for [Writing good commit messages](https://github.com/erlang/otp/wiki/Writing-good-commit-messages).
+
+* Don't merge `maint` or `master` into your branch. Use `git rebase` if you need to resolve merge
+conflicts or include the latest changes.
+
+* To make it possible to use the powerful `git bisect` command, make sure that each commit can be
+compiled and that it works.
+
+* Check for unnecessary whitespace before committing with `git diff --check`.
+
+Check your coding style:
+
+* Make sure your changes follow the coding and indentation style of the code surrounding your changes.
+
+* Do not commit commented-out code or files that are no longer needed. Remove the code or the files.
+
+* In most code (Erlang and C), indentation is 4 steps. Indentation using only spaces is **strongly recommended**.
+
+### Configuring Emacs
+
+If you use Emacs, use the Erlang mode, and add the following lines to `.emacs`:
+
+ (setq-default indent-tabs-mode nil)
+ (setq c-basic-offset 4)
+
+If you want to change the setting only for the Erlang mode, you can use a hook like this:
+
+```
+(add-hook 'erlang-mode-hook 'my-erlang-hook)
+
+(defun my-erlang-hook ()
+ (setq indent-tabs-mode nil))
+```
diff --git a/OTP_VERSION b/OTP_VERSION
index a824897d28..de56211047 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-19.2
+19.2.3
diff --git a/README.md b/README.md
index 127ac9cad7..8c77f0b39a 100644
--- a/README.md
+++ b/README.md
@@ -40,7 +40,7 @@ In short:
* Go to the JIRA issue tracker at [bugs.erlang.org] [7] to
see reported issues which you can contribute to.
- Search for issues with the status *Contribution Needed*.
+ Search for issues with the status *Help Wanted*.
Bug Reports
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 6c0544da31..80bf236188 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -1524,6 +1524,13 @@ ETHR_LIB_NAME=
ethr_modified_default_stack_size=
+AC_ARG_WITH(threadnames,
+AS_HELP_STRING([--with-threadnames], [use pthread_setname to set the thread names (default)])
+AS_HELP_STRING([--without-threadnames],
+ [do not set any thread names]),
+[],
+[with_threadnames=yes])
+
dnl Name of lib where ethread implementation is located
ethr_lib_name=ethread
@@ -1704,6 +1711,25 @@ case "$THR_LIB_NAME" in
AC_DEFINE(ETHR_TIME_WITH_SYS_TIME, 1, \
[Define if you can safely include both <sys/time.h> and <time.h>.]))
+ AC_MSG_CHECKING([for usable PTHREAD_STACK_MIN])
+ pthread_stack_min=no
+ AC_TRY_COMPILE([
+#include <limits.h>
+#if defined(ETHR_NEED_NPTL_PTHREAD_H)
+#include <nptl/pthread.h>
+#elif defined(ETHR_HAVE_MIT_PTHREAD_H)
+#include <pthread/mit/pthread.h>
+#elif defined(ETHR_HAVE_PTHREAD_H)
+#include <pthread.h>
+#endif
+ ],
+ [return PTHREAD_STACK_MIN;],
+ [pthread_stack_min=yes])
+
+ AC_MSG_RESULT([$pthread_stack_min])
+ test $pthread_stack_min != yes || {
+ AC_DEFINE(ETHR_HAVE_USABLE_PTHREAD_STACK_MIN, 1, [Define if you can use PTHREAD_STACK_MIN])
+ }
dnl
dnl Check for functions
@@ -1895,12 +1921,12 @@ case "$THR_LIB_NAME" in
[pthread_setname_np("name");],
pthread_setname=darwin)
AC_MSG_RESULT([$pthread_setname])
- case $pthread_setname in
- linux) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_2, 1,
+ case $with_threadnames-$pthread_setname in
+ yes-linux) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_2, 1,
[Define if you have linux style pthread_setname_np]);;
- bsd) AC_DEFINE(ETHR_HAVE_PTHREAD_SET_NAME_NP_2, 1,
+ yes-bsd) AC_DEFINE(ETHR_HAVE_PTHREAD_SET_NAME_NP_2, 1,
[Define if you have bsd style pthread_set_name_np]);;
- darwin) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_1, 1,
+ yes-darwin) AC_DEFINE(ETHR_HAVE_PTHREAD_SETNAME_NP_1, 1,
[Define if you have darwin style pthread_setname_np]);;
*) ;;
esac
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index f2a55f6298..8da832ac37 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1595,6 +1595,25 @@
</section>
<section>
+ <marker id="signals"></marker>
+ <title>Signals</title>
+ <p>On Unix systems, the Erlang runtime will interpret two types of signals.</p>
+ <taglist>
+ <tag><c>SIGUSR1</c></tag>
+ <item>
+ <p>A <c>SIGUSR1</c> signal forces a crash dump.</p>
+ </item>
+ <tag><c>SIGTERM</c></tag>
+ <item>
+ <p>A <c>SIGTERM</c> will produce a <c>stop</c> message to the <c>init</c> process.
+ This is equivalent to a <c>init:stop/0</c> call.</p>
+ <p>Introduced in ERTS 8.3 (Erlang/OTP 19.3)</p>
+ </item>
+ </taglist>
+ <p>The signal <c>SIGUSR2</c> is reserved for internal usage. No other signals are handled.</p>
+ </section>
+
+ <section>
<marker id="configuration"></marker>
<title>Configuration</title>
<p>The standard Erlang/OTP system can be reconfigured to change the default
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index d8bf45c523..7fbe97bc0b 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -1103,8 +1103,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
<marker id="driver_binary_dec_refc"></marker>
<p>Decrements the reference count on <c>bin</c> and returns
the reference count reached after the decrement.</p>
- <p>This function is only thread-safe when the emulator with SMP
- support is used.</p>
+ <p>This function is thread-safe.</p>
<note>
<p>The reference count of driver binary is normally to be decremented
by calling <seealso marker="#driver_free_binary">
@@ -1124,8 +1123,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
<desc>
<marker id="driver_binary_get_refc"></marker>
<p>Returns the current reference count on <c>bin</c>.</p>
- <p>This function is only thread-safe when the emulator with SMP
- support is used.</p>
+ <p>This function is thread-safe.</p>
</desc>
</func>
@@ -1137,8 +1135,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
<marker id="driver_binary_inc_refc"></marker>
<p>Increments the reference count on <c>bin</c> and returns
the reference count reached after the increment.</p>
- <p>This function is only thread-safe when the emulator with SMP
- support is used.</p>
+ <p>This function is thread-safe.</p>
</desc>
</func>
@@ -1434,8 +1431,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
<seealso marker="#driver_alloc_binary">
<c>driver_alloc_binary</c></seealso>. As binaries
in Erlang are reference counted, the binary can still be around.</p>
- <p>This function is only thread-safe when the emulator with SMP
- support is used.</p>
+ <p>This function is thread-safe.</p>
</desc>
</func>
@@ -1872,8 +1868,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
<p>Resizes a driver binary, while keeping the data.</p>
<p>Returns the resized driver binary on success. Returns <c>NULL</c>
on failure (out of memory).</p>
- <p>This function is only thread-safe when the emulator with SMP
- support is used.</p>
+ <p>This function is thread-safe.</p>
</desc>
</func>
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 9646953518..cf5f3fc99b 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4869,7 +4869,9 @@ RealSystem = system + MissedSystem</code>
<p><c><anno>BinInfo</anno></c> is a list containing miscellaneous
information about binaries currently referred to by this
process. This <c><anno>InfoTuple</anno></c> can be changed or
- removed without prior notice.</p>
+ removed without prior notice. In the current implementation
+ <c><anno>BinInfo</anno></c> is a list of tuples. The tuples
+ contain; <c>BinaryId</c>, <c>BinarySize</c>, <c>BinaryRefcCount</c>.</p>
</item>
<tag><c>{catchlevel, <anno>CatchLevel</anno>}</c></tag>
<item>
@@ -4899,7 +4901,9 @@ RealSystem = system + MissedSystem</code>
<p>Returns the current call stack back-trace (<em>stacktrace</em>)
of the process. The stack has the same format as returned by
<seealso marker="#get_stacktrace/0">
- <c>erlang:get_stacktrace/0</c></seealso>.</p>
+ <c>erlang:get_stacktrace/0</c></seealso>. The depth of the
+ stacktrace is truncated according to the <c>backtrace_depth</c>
+ system flag setting.</p>
</item>
<tag><c>{dictionary, <anno>Dictionary</anno>}</c></tag>
<item>
@@ -6611,7 +6615,9 @@ ok
<fsummary>Set system flag <c>backtrace_depth</c>.</fsummary>
<desc>
<p>Sets the maximum depth of call stack back-traces in the
- exit reason element of <c>'EXIT'</c> tuples.</p>
+ exit reason element of <c>'EXIT'</c> tuples. The flag
+ also limits the stacktrace depth returned by <c>process_info</c>
+ item <c>current_stacktrace.</c></p>
<p>Returns the old value of the flag.</p>
</desc>
</func>
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index da6190b685..ae1d2b1d93 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -32,6 +32,53 @@
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 8.2.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix bug in <c>binary_to_term</c> for binaries created by
+ <c>term_to_binary </c> with option <c>compressed</c>. The
+ bug can cause <c>badarg</c> exception for a valid binary
+ when Erlang VM is linked against a <c>zlib</c> library of
+ version 1.2.9 or newer. Bug exists since OTP 17.0.</p>
+ <p>
+ Own Id: OTP-14159 Aux Id: ERL-340 </p>
+ </item>
+ <item>
+ <p>
+ The driver efile_drv when opening a file now use fstat()
+ on the open file instead of stat() before opening, if
+ fstat() exists. This avoids a race when the file happens
+ to change between stat() and open().</p>
+ <p>
+ Own Id: OTP-14184 Aux Id: seq-13266 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 8.2.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix a quite rare bug causing VM crash during code loading
+ and the use of export funs (fun M:F/A) of not yet loaded
+ modules. Requires a very specfic timing of concurrent
+ scheduler threads. Has been seen on ARM but can probably
+ also occure on other architectures. Bug has existed since
+ OTP R16.</p>
+ <p>
+ Own Id: OTP-14144 Aux Id: seq13242 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 8.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -145,13 +192,6 @@
<p>
Own Id: OTP-14051</p>
</item>
- <item>
- <p>
- Fixed a number of bugs that caused faulty stack-traces to
- be created on exception when a process was traced.</p>
- <p>
- Own Id: OTP-14055</p>
- </item>
</list>
</section>
diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml
index 138414a880..7ae507b8f6 100644
--- a/erts/doc/src/zlib.xml
+++ b/erts/doc/src/zlib.xml
@@ -315,6 +315,15 @@ list_to_binary([B1,B2])</pre>
<c><anno>WindowBits</anno></c> value suppresses the zlib header
(and checksum) from the stream. Notice that the zlib source
mentions this only as a undocumented feature.</p>
+ <warning>
+ <p>Due to a known bug in the underlying zlib library, <c>WindowBits</c> values 8 and -8
+ do not work as expected. In zlib versions before 1.2.9 values
+ 8 and -8 are automatically changed to 9 and -9. <em>From zlib version 1.2.9
+ value -8 is rejected</em> causing <c>zlib:deflateInit/6</c> to fail
+ (8 is still changed to 9). It also seem possible that future versions
+ of zlib may fix this bug and start accepting 8 and -8 as is.</p>
+ <p>Conclusion: Avoid values 8 and -8 unless you know your zlib version supports them.</p>
+ </warning>
</item>
<tag><c><anno>MemLevel</anno></c></tag>
<item>
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index ea1323d651..7f5e9ff691 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -658,7 +658,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
}
else if (modp->old.code_hdr) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "Module %T must be purged before loading\n",
+ erts_dsprintf(dsbufp, "Module %T must be purged before deleting\n",
BIF_ARG_1);
erts_send_error_to_logger(BIF_P->group_leader, dsbufp);
ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
@@ -786,7 +786,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
}
if (BIF_ARG_2 == am_true) {
- int i;
+ int i, num_exps;
/*
* Make the code with the on_load function current.
@@ -802,7 +802,8 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
/*
* The on_load function succeded. Fix up export entries.
*/
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i,code_ix);
if (ep == NULL || ep->code[0] != BIF_ARG_1) {
continue;
@@ -822,14 +823,15 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
modp->curr.code_hdr->on_load_function_ptr = NULL;
set_default_trace_pattern(BIF_ARG_1);
} else if (BIF_ARG_2 == am_false) {
- int i;
+ int i, num_exps;
/*
* The on_load function failed. Remove references to the
* code that is about to be purged from the export entries.
*/
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i,code_ix);
if (ep == NULL || ep->code[0] != BIF_ARG_1) {
continue;
@@ -995,6 +997,12 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize))
goto literal_gc;
*redsp += 1;
+ if (c_p->abandoned_heap) {
+ if (any_heap_refs(c_p->abandoned_heap, c_p->abandoned_heap + c_p->heap_sz,
+ literals, lit_bsize))
+ goto literal_gc;
+ *redsp += 1;
+ }
if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize))
goto literal_gc;
@@ -1295,6 +1303,11 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
#endif
if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize))
goto try_literal_gc;
+ if (rp->abandoned_heap) {
+ if (any_heap_refs(rp->abandoned_heap, rp->abandoned_heap + rp->heap_sz,
+ literals, lit_bsize))
+ goto try_literal_gc;
+ }
if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize))
goto try_literal_gc;
@@ -2022,9 +2035,9 @@ delete_code(Module* modp)
{
ErtsCodeIndex code_ix = erts_staging_code_ix();
Eterm module = make_atom(modp->module);
- int i;
+ int i, num_exps = export_list_size(code_ix);
- for (i = 0; i < export_list_size(code_ix); i++) {
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i, code_ix);
if (ep != NULL && (ep->code[0] == module)) {
if (ep->addressv[code_ix] == ep->code+3) {
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index bbb2e4f34f..a66d9f68d9 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -74,6 +74,9 @@ extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
erts_smp_atomic32_t erts_active_bp_index;
erts_smp_atomic32_t erts_staging_bp_index;
+#ifdef ERTS_DIRTY_SCHEDULERS
+erts_smp_mtx_t erts_dirty_bp_ix_mtx;
+#endif
/*
* Inlined helpers
@@ -85,6 +88,31 @@ get_mtime(Process *c_p)
return erts_get_monotonic_time(erts_proc_sched_data(c_p));
}
+static ERTS_INLINE Uint32
+acquire_bp_sched_ix(Process *c_p)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ ASSERT(esdp);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
+ return (Uint32) erts_no_schedulers;
+ }
+#endif
+ return (Uint32) esdp->no - 1;
+}
+
+static ERTS_INLINE void
+release_bp_sched_ix(Uint32 ix)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ix == (Uint32) erts_no_schedulers)
+ erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
+#endif
+}
+
+
+
/* *************************************************************************
** Local prototypes
*/
@@ -135,6 +163,9 @@ void
erts_bp_init(void) {
erts_smp_atomic32_init_nob(&erts_active_bp_index, 0);
erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index");
+#endif
}
@@ -347,17 +378,17 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local)
}
if (flags & ERTS_BPF_META_TRACE) {
dst->meta_tracer = src->meta_tracer;
- erts_refc_inc(&dst->meta_tracer->refc, 1);
+ erts_smp_refc_inc(&dst->meta_tracer->refc, 1);
dst->meta_ms = src->meta_ms;
MatchSetRef(dst->meta_ms);
}
if (flags & ERTS_BPF_COUNT) {
dst->count = src->count;
- erts_refc_inc(&dst->count->refc, 1);
+ erts_smp_refc_inc(&dst->count->refc, 1);
}
if (flags & ERTS_BPF_TIME_TRACE) {
dst->time = src->time;
- erts_refc_inc(&dst->time->refc, 1);
+ erts_smp_refc_inc(&dst->time->refc, 1);
ASSERT(dst->time->hash);
}
}
@@ -973,6 +1004,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(c_p);
ASSERT(c_p);
ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING
@@ -980,7 +1012,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
/* get previous timestamp and breakpoint
* from the process psd */
-
+
pbt = ERTS_PROC_GET_CALL_TIME(c_p);
time = get_mtime(c_p);
@@ -1006,7 +1038,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
/* if null then the breakpoint was removed */
if (pbdt) {
- h = &(pbdt->hash[bp_sched2ix_proc(c_p)]);
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1027,7 +1059,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
/* this breakpoint */
ASSERT(bdt);
- h = &(bdt->hash[bp_sched2ix_proc(c_p)]);
+ h = &(bdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1041,6 +1073,8 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
pbt->pc = I;
pbt->time = time;
+
+ release_bp_sched_ix(six);
}
void
@@ -1051,6 +1085,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(p);
ASSERT(p);
ASSERT(erts_smp_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING
@@ -1071,6 +1106,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
*/
if (pbt) {
+
/* might have been removed due to
* trace_pattern(false)
*/
@@ -1085,7 +1121,8 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
/* beware, the trace_pattern might have been removed */
if (pbdt) {
- h = &(pbdt->hash[bp_sched2ix_proc(p)]);
+
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1096,11 +1133,15 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
} else {
BP_TIME_ADD(item, &sitem);
}
+
}
pbt->pc = pc;
pbt->time = time;
+
}
+
+ release_bp_sched_ix(six);
}
int
@@ -1353,6 +1394,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(p);
ASSERT(p);
@@ -1375,7 +1417,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
sitem.pid = p->common.id;
sitem.count = 0;
- h = &(pbdt->hash[bp_sched2ix_proc(p)]);
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1401,6 +1443,8 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
break;
}
} /* pbt */
+
+ release_bp_sched_ix(six);
}
/* *************************************************************************
@@ -1498,7 +1542,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
MatchSetRef(match_spec);
bp->meta_ms = match_spec;
bmt = Alloc(sizeof(BpMetaTracer));
- erts_refc_init(&bmt->refc, 1);
+ erts_smp_refc_init(&bmt->refc, 1);
erts_tracer_update(&meta_tracer, tracer); /* copy tracer */
erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer);
bp->meta_tracer = bmt;
@@ -1507,7 +1551,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
ASSERT((bp->flags & ERTS_BPF_COUNT) == 0);
bcp = Alloc(sizeof(BpCount));
- erts_refc_init(&bcp->refc, 1);
+ erts_smp_refc_init(&bcp->refc, 1);
erts_smp_atomic_init_nob(&bcp->acount, 0);
bp->count = bcp;
} else if (break_flags & ERTS_BPF_TIME_TRACE) {
@@ -1516,8 +1560,12 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0);
bdt = Alloc(sizeof(BpDataTime));
- erts_refc_init(&bdt->refc, 1);
- bdt->n = erts_no_total_schedulers;
+ erts_smp_refc_init(&bdt->refc, 1);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ bdt->n = erts_no_schedulers + 1;
+#else
+ bdt->n = erts_no_schedulers;
+#endif
bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n));
for (i = 0; i < bdt->n; i++) {
bp_hash_init(&(bdt->hash[i]), 32);
@@ -1583,7 +1631,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags)
static void
bp_meta_unref(BpMetaTracer* bmt)
{
- if (erts_refc_dectest(&bmt->refc, 0) <= 0) {
+ if (erts_smp_refc_dectest(&bmt->refc, 0) <= 0) {
ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer);
ERTS_TRACER_CLEAR(&trc);
Free(bmt);
@@ -1593,7 +1641,7 @@ bp_meta_unref(BpMetaTracer* bmt)
static void
bp_count_unref(BpCount* bcp)
{
- if (erts_refc_dectest(&bcp->refc, 0) <= 0) {
+ if (erts_smp_refc_dectest(&bcp->refc, 0) <= 0) {
Free(bcp);
}
}
@@ -1601,7 +1649,7 @@ bp_count_unref(BpCount* bcp)
static void
bp_time_unref(BpDataTime* bdt)
{
- if (erts_refc_dectest(&bdt->refc, 0) <= 0) {
+ if (erts_smp_refc_dectest(&bdt->refc, 0) <= 0) {
Uint i = 0;
Uint j = 0;
Process *h_p = NULL;
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index 7206ef471a..9e4ab3cd20 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -41,7 +41,7 @@ typedef struct {
typedef struct bp_data_time { /* Call time */
Uint n;
bp_time_hash_t *hash;
- erts_refc_t refc;
+ erts_smp_refc_t refc;
} BpDataTime;
typedef struct {
@@ -51,12 +51,12 @@ typedef struct {
typedef struct {
erts_smp_atomic_t acount;
- erts_refc_t refc;
+ erts_smp_refc_t refc;
} BpCount;
typedef struct {
erts_smp_atomic_t tracer;
- erts_refc_t refc;
+ erts_smp_refc_t refc;
} BpMetaTracer;
typedef struct generic_bp_data {
@@ -79,10 +79,8 @@ typedef struct generic_bp {
#define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1)
#define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2)
-#ifdef ERTS_SMP
-#define bp_sched2ix_proc(p) (erts_proc_sched_data(p)->thr_id - 1)
-#else
-#define bp_sched2ix_proc(p) (0)
+#ifdef ERTS_DIRTY_SCHEDULERS
+extern erts_smp_mtx_t erts_dirty_bp_ix_mtx;
#endif
enum erts_break_op{
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 59a9ea1417..1c83d8f02e 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1047,9 +1047,11 @@ static BeamInstr* handle_error(Process* c_p, BeamInstr* pc,
Eterm* reg, BifFunction bf) NOINLINE;
static BeamInstr* call_error_handler(Process* p, BeamInstr* ip,
Eterm* reg, Eterm func) NOINLINE;
-static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE;
+static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity,
+ BeamInstr *I, Uint offs) NOINLINE;
static BeamInstr* apply(Process* p, Eterm module, Eterm function,
- Eterm args, Eterm* reg) NOINLINE;
+ Eterm args, Eterm* reg,
+ BeamInstr *I, Uint offs) NOINLINE;
static BeamInstr* call_fun(Process* p, int arity,
Eterm* reg, Eterm args) NOINLINE;
static BeamInstr* apply_fun(Process* p, Eterm fun,
@@ -3194,7 +3196,7 @@ do { \
OpCase(i_apply): {
BeamInstr *next;
HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
+ next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0);
HEAVY_SWAPIN;
if (next != NULL) {
SET_CP(c_p, I+1);
@@ -3208,7 +3210,7 @@ do { \
OpCase(i_apply_last_P): {
BeamInstr *next;
HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
+ next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0));
HEAVY_SWAPIN;
if (next != NULL) {
SET_CP(c_p, (BeamInstr *) E[0]);
@@ -3223,7 +3225,7 @@ do { \
OpCase(i_apply_only): {
BeamInstr *next;
HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
+ next = apply(c_p, r(0), x(1), x(2), reg, I, 0);
HEAVY_SWAPIN;
if (next != NULL) {
SET_I(next);
@@ -3237,7 +3239,7 @@ do { \
BeamInstr *next;
HEAVY_SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0));
+ next = fixed_apply(c_p, reg, Arg(0), NULL, 0);
HEAVY_SWAPIN;
if (next != NULL) {
SET_CP(c_p, I+2);
@@ -3252,7 +3254,7 @@ do { \
BeamInstr *next;
HEAVY_SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0));
+ next = fixed_apply(c_p, reg, Arg(0), I, Arg(1));
HEAVY_SWAPIN;
if (next != NULL) {
SET_CP(c_p, (BeamInstr *) E[0]);
@@ -3550,18 +3552,11 @@ do { \
BifFunction vbf;
ErlHeapFragment *live_hf_end;
- if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) {
- /* If we have run out of reductions, we do a context
- switch before calling the nif */
- goto context_switch;
- }
-
ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
c_p->current = I-3; /* current and vbf set to please handle_error */
- SWAPOUT;
- c_p->fcalls = FCALLS - 1;
+ HEAVY_SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
bif_nif_arity = I[-1];
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
@@ -5844,12 +5839,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
s->depth = 0;
/*
- * If the failure was in a BIF other than 'error', 'exit' or
- * 'throw', find the bif-table index and save the argument
- * registers by consing up an arglist.
+ * If the failure was in a BIF other than 'error/1', 'error/2',
+ * 'exit/1' or 'throw/1', find the bif-table index and save the
+ * argument registers by consing up an arglist.
*/
- if (bf != NULL && bf != error_1 && bf != error_2 &&
- bf != exit_1 && bf != throw_1) {
+ if (bf != NULL && bf != error_1 && bf != error_2 && bf != exit_1
+ && bf != throw_1 && bf != wrap_error_1 && bf != wrap_error_2
+ && bf != wrap_exit_1 && bf != wrap_throw_1) {
int i;
int a = 0;
for (i = 0; i < BIF_SIZE; i++) {
@@ -5945,12 +5941,30 @@ erts_save_stacktrace(Process* p, struct StackTrace* s, int depth)
p->cp) {
/* Cannot follow cp here - code may be unloaded */
BeamInstr *cpp = p->cp;
+ int trace_cp;
if (cpp == beam_exception_trace || cpp == beam_return_trace) {
/* Skip return_trace parameters */
ptr += 2;
+ trace_cp = 1;
} else if (cpp == beam_return_to_trace) {
/* Skip return_to_trace parameters */
ptr += 1;
+ trace_cp = 1;
+ }
+ else {
+ trace_cp = 0;
+ }
+ if (trace_cp && s->pc == cpp) {
+ /*
+ * If process 'cp' points to a return/exception trace
+ * instruction and 'cp' has been saved as 'pc' in
+ * stacktrace, we need to update 'pc' in stacktrace
+ * with the actual 'cp' located on the top of the
+ * stack; otherwise, we will lose the top stackframe
+ * when building the stack trace.
+ */
+ ASSERT(is_CP(p->stop[0]));
+ s->pc = cp_val(p->stop[0]);
}
}
while (ptr < STACK_START(p) && depth > 0) {
@@ -6070,12 +6084,15 @@ build_stacktrace(Process* c_p, Eterm exc) {
erts_set_current_function(&fi, s->current);
}
+ depth = s->depth;
/*
- * If fi.current is still NULL, default to the initial function
+ * If fi.current is still NULL, and we have no
+ * stack at all, default to the initial function
* (e.g. spawn_link(erlang, abs, [1])).
*/
if (fi.current == NULL) {
- erts_set_current_function(&fi, c_p->u.initial);
+ if (depth <= 0)
+ erts_set_current_function(&fi, c_p->u.initial);
args = am_true; /* Just in case */
} else {
args = get_args_from_exc(exc);
@@ -6085,10 +6102,9 @@ build_stacktrace(Process* c_p, Eterm exc) {
* Look up all saved continuation pointers and calculate
* needed heap space.
*/
- depth = s->depth;
stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
depth*sizeof(FunctionInfo));
- heap_size = fi.needed + 2;
+ heap_size = fi.current ? fi.needed + 2 : 0;
for (i = 0; i < depth; i++) {
erts_lookup_function_info(stkp, s->trace[i], 1);
if (stkp->current) {
@@ -6107,8 +6123,10 @@ build_stacktrace(Process* c_p, Eterm exc) {
res = CONS(hp, mfa, res);
hp += 2;
}
- hp = erts_build_mfa_item(&fi, hp, args, &mfa);
- res = CONS(hp, mfa, res);
+ if (fi.current) {
+ hp = erts_build_mfa_item(&fi, hp, args, &mfa);
+ res = CONS(hp, mfa, res);
+ }
erts_free(ERTS_ALC_T_TMP, (void *) stk);
return res;
@@ -6205,8 +6223,107 @@ apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity,
return ep;
}
+static ERTS_INLINE void
+apply_bif_error_adjustment(Process *p, Export *ep,
+ Eterm *reg, Uint arity,
+ BeamInstr *I, Uint stack_offset)
+{
+ /*
+ * I is only set when the apply is a tail call, i.e.,
+ * from the instructions i_apply_only, i_apply_last_P,
+ * and apply_last_IP.
+ */
+ if (I
+ && ep->code[3] == (BeamInstr) em_apply_bif
+ && (ep == bif_export[BIF_error_1]
+ || ep == bif_export[BIF_error_2]
+ || ep == bif_export[BIF_exit_1]
+ || ep == bif_export[BIF_throw_1])) {
+ /*
+ * We are about to tail apply one of the BIFs
+ * erlang:error/1, erlang:error/2, erlang:exit/1,
+ * or erlang:throw/1. Error handling of these BIFs is
+ * special!
+ *
+ * We need 'p->cp' to point into the calling
+ * function when handling the error after the BIF has
+ * been applied. This in order to get the topmost
+ * stackframe correct. Without the following adjustment,
+ * 'p->cp' will point into the function that called
+ * current function when handling the error. We add a
+ * dummy stackframe in order to achive this.
+ *
+ * Note that these BIFs unconditionally will cause
+ * an exception to be raised. That is, our modifications
+ * of 'p->cp' as well as the stack will be corrected by
+ * the error handling code.
+ *
+ * If we find an exception/return-to trace continuation
+ * pointer as the topmost continuation pointer, we do not
+ * need to do anything since the information already will
+ * be available for generation of the stacktrace.
+ */
+ int apply_only = stack_offset == 0;
+ BeamInstr *cpp;
+
+ if (apply_only) {
+ ASSERT(p->cp != NULL);
+ cpp = p->cp;
+ }
+ else {
+ ASSERT(is_CP(p->stop[0]));
+ cpp = cp_val(p->stop[0]);
+ }
+
+ if (cpp != beam_exception_trace
+ && cpp != beam_return_trace
+ && cpp != beam_return_to_trace) {
+ Uint need = stack_offset /* bytes */ / sizeof(Eterm);
+ if (need == 0)
+ need = 1; /* i_apply_only */
+ if (p->stop - p->htop < need)
+ erts_garbage_collect(p, (int) need, reg, arity+1);
+ p->stop -= need;
+
+ if (apply_only) {
+ /*
+ * Called from the i_apply_only instruction.
+ *
+ * 'p->cp' contains continuation pointer pointing
+ * into the function that called current function.
+ * We push that continuation pointer onto the stack,
+ * and set 'p->cp' to point into current function.
+ */
+
+ p->stop[0] = make_cp(p->cp);
+ p->cp = I;
+ }
+ else {
+ /*
+ * Called from an i_apply_last_p, or apply_last_IP,
+ * instruction.
+ *
+ * Calling instruction will after we return read
+ * a continuation pointer from the stack and write
+ * it to 'p->cp', and then remove the topmost
+ * stackframe of size 'stack_offset'.
+ *
+ * We have sized the dummy-stackframe so that it
+ * will be removed by the instruction we currently
+ * are executing, and leave the stackframe that
+ * normally would have been removed intact.
+ *
+ */
+ p->stop[0] = make_cp(I);
+ }
+ }
+ }
+}
+
static BeamInstr*
-apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
+apply(
+Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg,
+BeamInstr *I, Uint stack_offset)
{
int arity;
Export* ep;
@@ -6231,21 +6348,54 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
return 0;
}
- /* The module argument may be either an atom or an abstract module
- * (currently implemented using tuples, but this might change).
- */
- this = THE_NON_VALUE;
- if (is_not_atom(module)) {
- Eterm* tp;
+ while (1) {
+ Eterm m, f, a;
+ /* The module argument may be either an atom or an abstract module
+ * (currently implemented using tuples, but this might change).
+ */
+ this = THE_NON_VALUE;
+ if (is_not_atom(module)) {
+ Eterm* tp;
+
+ if (is_not_tuple(module)) goto error;
+ tp = tuple_val(module);
+ if (arityval(tp[0]) < 1) goto error;
+ this = module;
+ module = tp[1];
+ if (is_not_atom(module)) goto error;
+ }
- if (is_not_tuple(module)) goto error;
- tp = tuple_val(module);
- if (arityval(tp[0]) < 1) goto error;
- this = module;
- module = tp[1];
- if (is_not_atom(module)) goto error;
+ if (module != am_erlang || function != am_apply)
+ break;
+
+ /* Adjust for multiple apply of apply/3... */
+
+ a = args;
+ if (is_list(a)) {
+ Eterm *consp = list_val(a);
+ m = CAR(consp);
+ a = CDR(consp);
+ if (is_list(a)) {
+ consp = list_val(a);
+ f = CAR(consp);
+ a = CDR(consp);
+ if (is_list(a)) {
+ consp = list_val(a);
+ a = CAR(consp);
+ if (is_nil(CDR(consp))) {
+ /* erlang:apply/3 */
+ module = m;
+ function = f;
+ args = a;
+ if (is_not_atom(f))
+ goto error;
+ continue;
+ }
+ }
+ }
+ }
+ break; /* != erlang:apply/3 */
}
-
/*
* Walk down the 3rd parameter of apply (the argument list) and copy
* the parameters to the x registers (reg[]). If the module argument
@@ -6283,12 +6433,14 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
} else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
save_calls(p, ep);
}
+ apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset);
DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep);
return ep->addressv[erts_active_code_ix()];
}
static BeamInstr*
-fixed_apply(Process* p, Eterm* reg, Uint arity)
+fixed_apply(Process* p, Eterm* reg, Uint arity,
+ BeamInstr *I, Uint stack_offset)
{
Export* ep;
Eterm module;
@@ -6318,6 +6470,10 @@ fixed_apply(Process* p, Eterm* reg, Uint arity)
if (is_not_atom(module)) goto error;
++arity;
}
+
+ /* Handle apply of apply/3... */
+ if (module == am_erlang && function == am_apply && arity == 3)
+ return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset);
/*
* Get the index into the export table, or failing that the export
@@ -6332,6 +6488,7 @@ fixed_apply(Process* p, Eterm* reg, Uint arity)
} else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
save_calls(p, ep);
}
+ apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset);
DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep);
return ep->addressv[erts_active_code_ix()];
}
@@ -6678,7 +6835,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
p->htop = hp + needed;
funp = (ErlFunThing *) hp;
hp = funp->env;
- erts_refc_inc(&fe->refc, 2);
+ erts_smp_refc_inc(&fe->refc, 2);
funp->thing_word = HEADER_FUN;
funp->next = MSO(p).first;
MSO(p).first = (struct erl_off_heap_header*) funp;
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 0afdedf6c2..88b6e89a02 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -797,14 +797,14 @@ erts_finish_loading(Binary* magic, Process* c_p,
} else {
ErtsCodeIndex code_ix = erts_staging_code_ix();
Eterm module = stp->module;
- int i;
+ int i, num_exps;
/*
* There is an -on_load() function. We will keep the current
* code, but we must turn off any tracing.
*/
-
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i, code_ix);
if (ep == NULL || ep->code[0] != module) {
continue;
@@ -4867,7 +4867,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
/*
* We are hiding a pointer into older code.
*/
- erts_refc_dec(&fe->refc, 1);
+ erts_smp_refc_dec(&fe->refc, 1);
}
fe->address = code_ptr;
#ifdef HIPE
@@ -5754,12 +5754,13 @@ exported_from_module(Process* p, /* Process whose heap to use. */
ErtsCodeIndex code_ix,
Eterm mod) /* Tagged atom for module. */
{
- int i;
+ int i, num_exps;
Eterm* hp = NULL;
Eterm* hend = NULL;
Eterm result = NIL;
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export* ep = export_list(i,code_ix);
if (ep->code[0] == mod) {
@@ -6286,7 +6287,7 @@ patch_funentries(Eterm Patchlist)
*
* Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge
*
- * erts_refc_dec(&fe->refc, 1);
+ * erts_smp_refc_dec(&fe->refc, 1);
*/
if (!patch(Addresses, (Uint) fe))
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index dfbe1ced47..4c7c910419 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -379,6 +379,18 @@ info(fmtfn_t to, void *to_arg)
}
+static int code_size(struct erl_module_instance* modi)
+{
+ int size = modi->code_length;
+
+ if (modi->code_hdr) {
+ ErtsLiteralArea* lit = modi->code_hdr->literal_area;
+ if (lit)
+ size += (lit->end - lit->start) * sizeof(Eterm);
+ }
+ return size;
+}
+
void
loaded(fmtfn_t to, void *to_arg)
{
@@ -396,13 +408,9 @@ loaded(fmtfn_t to, void *to_arg)
* Calculate and print totals.
*/
for (i = 0; i < module_code_size(code_ix); i++) {
- if ((modp = module_code(i, code_ix)) != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
- cur += modp->curr.code_length;
- if (modp->old.code_length != 0) {
- old += modp->old.code_length;
- }
+ if ((modp = module_code(i, code_ix)) != NULL) {
+ cur += code_size(&modp->curr);
+ old += code_size(&modp->old);
}
}
erts_print(to, to_arg, "Current code: %d\n", cur);
@@ -418,31 +426,25 @@ loaded(fmtfn_t to, void *to_arg)
/*
* Interactive dump; keep it brief.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
- erts_print(to, to_arg, "%T", make_atom(modp->module));
- cur += modp->curr.code_length;
- erts_print(to, to_arg, " %d", modp->curr.code_length );
- if (modp->old.code_length != 0) {
- erts_print(to, to_arg, " (%d old)",
- modp->old.code_length );
- old += modp->old.code_length;
- }
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
+ erts_print(to, to_arg, "%T %d", make_atom(modp->module),
+ code_size(&modp->curr));
+ if (modp->old.code_length != 0)
+ erts_print(to, to_arg, " (%d old)", code_size(&modp->old));
erts_print(to, to_arg, "\n");
}
} else {
/*
* To crash dump; make it parseable.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
erts_print(to, to_arg, "=mod:");
erts_print(to, to_arg, "%T", make_atom(modp->module));
erts_print(to, to_arg, "\n");
erts_print(to, to_arg, "Current size: %d\n",
- modp->curr.code_length);
+ code_size(&modp->curr));
code = modp->curr.code_hdr;
if (code != NULL && code->attr_ptr) {
erts_print(to, to_arg, "Current attributes: ");
@@ -456,7 +458,7 @@ loaded(fmtfn_t to, void *to_arg)
}
if (modp->old.code_length != 0) {
- erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length);
+ erts_print(to, to_arg, "Old size: %d\n", code_size(&modp->old));
code = modp->old.code_hdr;
if (code->attr_ptr) {
erts_print(to, to_arg, "Old attributes: ");
@@ -647,7 +649,7 @@ bin_check(void)
erts_printf("%p orig_size: %bpd, norefs = %bpd\n",
bp->val,
bp->val->orig_size,
- erts_smp_atomic_read_nob(&bp->val->refc));
+ erts_refc_read(&bp->val->refc, 1));
}
}
if (printed) {
@@ -717,6 +719,8 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
* We have to be very very careful when doing this as the schedulers
* could be anywhere.
*/
+ sys_init_suspend_handler();
+
for (i = 0; i < erts_no_schedulers; i++) {
erts_tid_t tid = ERTS_SCHEDULER_IX(i)->tid;
if (!erts_equal_tids(tid,erts_thr_self()))
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index ccc4cbad43..78db141cfc 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -826,7 +826,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
funp = (ErlFunThing *) tp;
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
- erts_refc_inc(&funp->fe->refc, 2);
+ erts_smp_refc_inc(&funp->fe->refc, 2);
*argp = make_fun(tp);
}
break;
@@ -845,7 +845,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
etp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*)etp;
- erts_refc_inc(&etp->node->refc, 2);
+ erts_smp_refc_inc(&etp->node->refc, 2);
*argp = make_external(tp);
}
@@ -1491,7 +1491,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
}
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
- erts_refc_inc(&funp->fe->refc, 2);
+ erts_smp_refc_inc(&funp->fe->refc, 2);
goto cleanup_next;
}
case MAP_SUBTAG:
@@ -1626,7 +1626,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
}
etp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) etp;
- erts_refc_inc(&etp->node->refc, 2);
+ erts_smp_refc_inc(&etp->node->refc, 2);
goto cleanup_next;
}
default:
@@ -1802,7 +1802,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) (tp-1);
- erts_refc_inc(&funp->fe->refc, 2);
+ erts_smp_refc_inc(&funp->fe->refc, 2);
}
goto off_heap_common;
case EXTERNAL_PID_SUBTAG:
@@ -1810,7 +1810,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (tp-1);
- erts_refc_inc(&etp->node->refc, 2);
+ erts_smp_refc_inc(&etp->node->refc, 2);
}
off_heap_common:
{
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index d79245e0e6..52b2174609 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -2081,7 +2081,7 @@ erts_dist_command(Port *prt, int reds_limit)
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be
+ erts_smp_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be
removed if port command fails */
erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 0);
@@ -2514,7 +2514,7 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte
erts_print(to, arg, "Name: %T", dep->sysname);
#ifdef DEBUG
- erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 0));
+ erts_print(to, arg, " (refc=%d)", erts_smp_refc_read(&dep->refc, 0));
#endif
erts_print(to, arg, "\n");
if (!connected && is_nil(dep->cid)) {
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index ef77201544..bace51bbbb 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -1109,25 +1109,25 @@ void erts_ddll_decrement_port_count(DE_Handle *dh)
static void first_ddll_reference(DE_Handle *dh)
{
assert_drv_list_rwlocked();
- erts_refc_init(&(dh->refc),1);
+ erts_smp_refc_init(&(dh->refc),1);
}
void erts_ddll_reference_driver(DE_Handle *dh)
{
assert_drv_list_locked();
- if (erts_refc_inctest(&(dh->refc),1) == 1) {
- erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
+ if (erts_smp_refc_inctest(&(dh->refc),1) == 1) {
+ erts_smp_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
}
}
void erts_ddll_reference_referenced_driver(DE_Handle *dh)
{
- erts_refc_inc(&(dh->refc),2);
+ erts_smp_refc_inc(&(dh->refc),2);
}
void erts_ddll_dereference_driver(DE_Handle *dh)
{
- if (erts_refc_dectest(&(dh->refc),0) == 0) {
+ if (erts_smp_refc_dectest(&(dh->refc),0) == 0) {
/* No lock here, but if the driver is referenced again,
the scheduled deletion is added as a reference too, see above */
erts_schedule_misc_op(ddll_no_more_references, (void *) dh);
@@ -1150,11 +1150,11 @@ static void restore_process_references(DE_Handle *dh)
{
DE_ProcEntry *p;
assert_drv_list_rwlocked();
- ASSERT(erts_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
for(p = dh->procs;p != NULL; p = p->next) {
if (p->awaiting_status == ERL_DE_PROC_LOADED) {
ASSERT(p->flags & ERL_DE_FL_DEREFERENCED);
- erts_refc_inc(&(dh->refc),1);
+ erts_smp_refc_inc(&(dh->refc),1);
p->flags &= ~ERL_DE_FL_DEREFERENCED;
}
}
@@ -1176,9 +1176,9 @@ static void ddll_no_more_references(void *vdh)
lock_drv_list();
- x = erts_refc_read(&(dh->refc),0);
+ x = erts_smp_refc_read(&(dh->refc),0);
if (x > 0) {
- x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
+ x = erts_smp_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
}
@@ -1643,7 +1643,7 @@ static int load_driver_entry(DE_Handle **dhp, char *path, char *name)
dh->handle = NULL;
dh->procs = NULL;
erts_smp_atomic32_init_nob(&dh->port_count, 0);
- erts_refc_init(&(dh->refc), (erts_aint_t) 0);
+ erts_smp_refc_init(&(dh->refc), (erts_aint_t) 0);
dh->status = -1;
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
@@ -1681,7 +1681,7 @@ static int reload_driver_entry(DE_Handle *dh)
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
- ASSERT(erts_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
ASSERT(dh->full_path != NULL);
erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path);
dh->full_path = NULL;
diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c
index b42d2dc28b..74cf7cf11a 100644
--- a/erts/emulator/beam/erl_bif_guard.c
+++ b/erts/emulator/beam/erl_bif_guard.c
@@ -157,7 +157,7 @@ BIF_RETTYPE round_1(BIF_ALIST_1)
GET_DOUBLE(BIF_ARG_1, f);
/* round it and return the resultant integer */
- res = double_to_integer(BIF_P, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5);
+ res = double_to_integer(BIF_P, round(f.fd));
BIF_RET(res);
}
@@ -597,8 +597,7 @@ Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live)
}
GET_DOUBLE(arg, f);
- return gc_double_to_integer(p, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5,
- reg, live);
+ return gc_double_to_integer(p, round(f.fd), reg, live);
}
Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 735aabbee3..95a56a3de9 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -174,7 +174,7 @@ bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
if (szp)
*szp += 4+2;
if (hpp) {
- Uint refc = (Uint) erts_smp_atomic_read_nob(&pb->val->refc);
+ Uint refc = (Uint) erts_refc_read(&pb->val->refc, 1);
tuple = TUPLE3(*hpp, val, orig_size, make_small(refc));
res = CONS(*hpp + 4, tuple, res);
*hpp += 4+2;
@@ -1672,11 +1672,11 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
Eterm mfa;
Eterm res = NIL;
- depth = 8;
+ depth = erts_backtrace_depth;
sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
s->depth = 0;
- if (rp->i) {
+ if (depth > 0 && rp->i) {
s->trace[s->depth++] = rp->i;
depth--;
}
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 96275eb228..0627526d7e 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1062,9 +1062,16 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
erts_smp_thr_progress_block();
}
#endif
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
+#endif
+
r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
+#endif
#ifdef ERTS_SMP
if ( (key == am_call_time) || (key == am_all)) {
erts_smp_thr_progress_unblock();
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index dceadc46f4..3cc2b21a20 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -266,7 +266,7 @@ static void schedule_free_dbtable(DbTable* tb)
* Caller is *not* allowed to access the specialized part
* (hash or tree) of *tb after this function has returned.
*/
- ASSERT(erts_refc_read(&tb->common.ref, 0) == 0);
+ ASSERT(erts_smp_refc_read(&tb->common.ref, 0) == 0);
erts_schedule_thr_prgr_later_cleanup_op(free_dbtable,
(void *) tb,
&tb->release.data,
@@ -600,11 +600,11 @@ done:
*/
static ERTS_INLINE void local_fix_table(DbTable* tb)
{
- erts_refc_inc(&tb->common.ref, 1);
+ erts_smp_refc_inc(&tb->common.ref, 1);
}
static ERTS_INLINE void local_unfix_table(DbTable* tb)
{
- if (erts_refc_dectest(&tb->common.ref, 0) == 0) {
+ if (erts_smp_refc_dectest(&tb->common.ref, 0) == 0) {
ASSERT(IS_HASH_TABLE(tb->common.status));
db_unfix_table_hash(&(tb->hash));
}
@@ -1487,7 +1487,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
tb->common.type = status & ERTS_ETS_TABLE_TYPES;
/* Note, 'type' is *read only* from now on... */
#endif
- erts_refc_init(&tb->common.ref, 0);
+ erts_smp_refc_init(&tb->common.ref, 0);
db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ),
"db_tab", "db_tab_fix");
tb->common.keypos = keypos;
@@ -2990,7 +2990,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
meta_pid_to_tab->common.meth = &db_hash;
meta_pid_to_tab->common.compress = 0;
- erts_refc_init(&meta_pid_to_tab->common.ref, 0);
+ erts_smp_refc_init(&meta_pid_to_tab->common.ref, 0);
/* Neither rwlock or fixlock used
db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/
@@ -3021,7 +3021,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
meta_pid_to_fixed_tab->common.meth = &db_hash;
meta_pid_to_fixed_tab->common.compress = 0;
- erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0);
+ erts_smp_refc_init(&meta_pid_to_fixed_tab->common.ref, 0);
/* Neither rwlock or fixlock used
db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/
@@ -3382,7 +3382,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
if ((*pp)->pid == pid) {
DbFixation* fix = *pp;
erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_refc_add(&tb->common.ref,diff,0);
+ erts_smp_refc_add(&tb->common.ref,diff,0);
*pp = fix->next;
erts_db_free(ERTS_ALC_T_DB_FIXATION,
tb, fix, sizeof(DbFixation));
@@ -3458,7 +3458,7 @@ static void fix_table_locked(Process* p, DbTable* tb)
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#endif
- erts_refc_inc(&tb->common.ref,1);
+ erts_smp_refc_inc(&tb->common.ref,1);
fix = tb->common.fixations;
if (fix == NULL) {
tb->common.time.monotonic
@@ -3514,7 +3514,7 @@ static void unfix_table_locked(Process* p, DbTable* tb,
for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) {
if ((*pp)->pid == p->common.id) {
DbFixation* fix = *pp;
- erts_refc_dec(&tb->common.ref,0);
+ erts_smp_refc_dec(&tb->common.ref,0);
--(fix->counter);
ASSERT(fix->counter >= 0);
if (fix->counter > 0) {
@@ -3563,7 +3563,7 @@ static void free_fixations_locked(DbTable *tb)
fix = tb->common.fixations;
while (fix != NULL) {
erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_refc_add(&tb->common.ref,diff,0);
+ erts_smp_refc_add(&tb->common.ref,diff,0);
next_fix = fix->next;
db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
db_erase_bag_exact2(meta_pid_to_fixed_tab,
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 6732b708a8..f4db7ca3dd 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -3107,7 +3107,7 @@ void db_cleanup_offheap_comp(DbTerm* obj)
break;
case FUN_SUBTAG:
ASSERT(u.pb != &tmp);
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 49e5f6b4cf..3fb063797e 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -211,7 +211,7 @@ typedef struct db_fixation {
*/
typedef struct db_table_common {
- erts_refc_t ref; /* fixation counter */
+ erts_smp_refc_t ref; /* fixation counter */
#ifdef ERTS_SMP
erts_smp_rwmtx_t rwlock; /* rw lock on table */
erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */
@@ -260,7 +260,7 @@ typedef struct db_table_common {
(DB_BAG | DB_SET | DB_DUPLICATE_BAG)))
#define IS_TREE_TABLE(Status) (!!((Status) & \
DB_ORDERED_SET))
-#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0))
+#define NFIXED(T) (erts_smp_refc_read(&(T)->common.ref,0))
#define IS_FIXED(T) (NFIXED(T) != 0)
/*
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index d0a57f0ad0..fd4d5b1c5c 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -110,9 +110,9 @@ erts_put_fun_entry(Eterm mod, int uniq, int index)
fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template);
sys_memset(fe->uniq, 0, sizeof(fe->uniq));
fe->index = 0;
- refc = erts_refc_inctest(&fe->refc, 0);
+ refc = erts_smp_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&fe->refc, 1);
+ erts_smp_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -134,9 +134,9 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq));
fe->index = index;
fe->arity = arity;
- refc = erts_refc_inctest(&fe->refc, 0);
+ refc = erts_smp_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&fe->refc, 1);
+ erts_smp_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -161,9 +161,9 @@ erts_get_fun_entry(Eterm mod, int uniq, int index)
erts_fun_read_lock();
ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template);
if (ret) {
- erts_aint_t refc = erts_refc_inctest(&ret->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&ret->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&ret->refc, 1);
+ erts_smp_refc_inc(&ret->refc, 1);
}
erts_fun_read_unlock();
return ret;
@@ -184,7 +184,7 @@ erts_erase_fun_entry(ErlFunEntry* fe)
* We have to check refc again since someone might have looked up
* the fun entry and incremented refc after last check.
*/
- if (erts_refc_dectest(&fe->refc, -1) <= 0)
+ if (erts_smp_refc_dectest(&fe->refc, -1) <= 0)
#endif
{
if (fe->address != unloaded_fun)
@@ -256,7 +256,7 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
for (ix = 0; ix < no; ix++) {
ErlFunEntry *fe = funs[ix];
fe->pend_purge_address = NULL;
- if (erts_refc_dectest(&fe->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
erts_erase_fun_entry(fe);
}
ERTS_SMP_WRITE_MEMORY_BARRIER;
@@ -288,7 +288,7 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg)
#ifdef HIPE
erts_print(to, to_arg, "Native_address: %p\n", fe->native_address);
#endif
- erts_print(to, to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1));
+ erts_print(to, to_arg, "Refc: %ld\n", erts_smp_refc_read(&fe->refc, 1));
b = b->next;
}
}
@@ -319,7 +319,7 @@ fun_alloc(ErlFunEntry* template)
obj->old_uniq = template->old_uniq;
obj->old_index = template->old_index;
obj->module = template->module;
- erts_refc_init(&obj->refc, -1);
+ erts_smp_refc_init(&obj->refc, -1);
obj->address = unloaded_fun;
obj->pend_purge_address = NULL;
#ifdef HIPE
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index caa55c730c..0fd0d62343 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -42,7 +42,7 @@ typedef struct erl_fun_entry {
Uint arity; /* The arity of the fun. */
Eterm module; /* Tagged atom for module. */
- erts_refc_t refc; /* Reference count: One for code + one for each
+ erts_smp_refc_t refc; /* Reference count: One for code + one for each
fun object in each process. */
BeamInstr *pend_purge_address; /* address stored during a pending purge */
} ErlFunEntry;
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index af799d09da..9b7744068e 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -59,6 +59,10 @@
# define ERTS_GC_ASSERT(B) ((void) 1)
#endif
+#if defined(DEBUG) && 0
+# define HARDDEBUG 1
+#endif
+
/*
* Returns number of elements in an array.
*/
@@ -110,7 +114,6 @@ typedef struct {
static Uint setup_rootset(Process*, Eterm*, int, Rootset*);
static void cleanup_rootset(Rootset *rootset);
-static void remove_message_buffers(Process* p);
static Eterm *full_sweep_heaps(Process *p,
int hibernate,
Eterm *n_heap, Eterm* n_htop,
@@ -153,7 +156,7 @@ static void init_gc_info(ErtsGCInfo *gcip);
static Uint64 next_vheap_size(Process* p, Uint64 vheap, Uint64 vheap_sz);
#ifdef HARDDEBUG
-static void disallow_heap_frag_ref_in_heap(Process* p);
+static void disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop);
static void disallow_heap_frag_ref_in_old_heap(Process* p);
#endif
@@ -176,6 +179,13 @@ typedef struct {
erts_smp_atomic32_t refc;
} ErtsGCInfoReq;
+#ifdef ERTS_DIRTY_SCHEDULERS
+static struct {
+ erts_mtx_t mtx;
+ ErtsGCInfo info;
+} dirty_gc;
+#endif
+
static ERTS_INLINE int
gc_cost(Uint gc_moved_live_words, Uint resize_moved_words)
{
@@ -259,6 +269,11 @@ erts_init_gc(void)
init_gc_info(&esdp->gc_info);
}
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info");
+ init_gc_info(&dirty_gc.info);
+#endif
+
init_gcireq_alloc();
}
@@ -477,24 +492,26 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int
hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE;
hfrag = new_message_buffer(hsz);
- hfrag->next = p->mbuf;
- p->mbuf = hfrag;
- p->mbuf_sz += hsz;
p->heap = p->htop = &hfrag->mem[0];
p->hend = hend = &hfrag->mem[hsz];
p->stop = stop = hend - ssz;
sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm));
if (p->abandoned_heap) {
- /* Active heap already in a fragment; adjust it... */
- ErlHeapFragment *hfrag = ((ErlHeapFragment *)
- (((char *) orig_heap)
- - offsetof(ErlHeapFragment, mem)));
- Uint unused = orig_hend - orig_htop;
- ASSERT(hfrag->used_size == hfrag->alloc_size);
- ASSERT(hfrag->used_size >= unused);
- hfrag->used_size -= unused;
- p->mbuf_sz -= unused;
+ /*
+ * Active heap already in a fragment; adjust it and
+ * save it into mbuf list...
+ */
+ ErlHeapFragment *hfrag = ((ErlHeapFragment *)
+ (((char *) orig_heap)
+ - offsetof(ErlHeapFragment, mem)));
+ Uint used = orig_htop - orig_heap;
+ hfrag->used_size = used;
+ p->mbuf_sz += used;
+ ASSERT(hfrag->used_size <= hfrag->alloc_size);
+ ASSERT(!hfrag->off_heap.first && !hfrag->off_heap.overhead);
+ hfrag->next = p->mbuf;
+ p->mbuf = hfrag;
}
else {
/* Do not leave a hole in the abandoned heap... */
@@ -556,17 +573,14 @@ young_gen_usage(Process *p)
}
}
+ hsz += p->htop - p->heap;
aheap = p->abandoned_heap;
- if (!aheap)
- hsz += p->htop - p->heap;
- else {
+ if (aheap) {
/* used in orig heap */
if (p->flags & F_ABANDONED_HEAP_USE)
hsz += aheap[p->heap_sz-1];
else
hsz += p->heap_sz;
- /* Remove unused part in latest fragment */
- hsz -= p->hend - p->htop;
}
return hsz;
}
@@ -602,7 +616,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
Uint reclaimed_now = 0;
Eterm gc_trace_end_tag;
int reds;
- ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */
+ ErtsMonotonicTime start_time;
ErtsSchedulerData *esdp;
erts_aint32_t state;
ERTS_MSACC_PUSH_STATE_M();
@@ -610,6 +624,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
#endif
+ ERTS_UNDEF(start_time, 0);
ERTS_CHK_MBUF_SZ(p);
ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls)
@@ -735,8 +750,19 @@ do_major_collection:
monitor_large_heap(p);
}
- esdp->gc_info.garbage_cols++;
- esdp->gc_info.reclaimed += reclaimed_now;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ erts_mtx_lock(&dirty_gc.mtx);
+ dirty_gc.info.garbage_cols++;
+ dirty_gc.info.reclaimed += reclaimed_now;
+ erts_mtx_unlock(&dirty_gc.mtx);
+ }
+ else
+#endif
+ {
+ esdp->gc_info.garbage_cols++;
+ esdp->gc_info.reclaimed += reclaimed_now;
+ }
FLAGS(p) &= ~F_FORCE_GC;
p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
@@ -765,6 +791,7 @@ do_major_collection:
ASSERT(!p->mbuf);
ASSERT(!ERTS_IS_GC_DESIRED(p));
+ ASSERT(need <= HEAP_LIMIT(p) - HEAP_TOP(p));
return reds;
}
@@ -789,6 +816,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
>= erts_proc_sched_data(p)->virtual_reds);
}
+
/*
* Place all living data on a the new heap; deallocate any old heap.
* Meant to be used by hibernate/3.
@@ -835,11 +863,11 @@ erts_garbage_collect_hibernate(Process* p)
p->arg_reg,
p->arity);
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (p->abandoned_heap
- ? p->abandoned_heap
- : p->heap),
- p->heap_sz * sizeof(Eterm));
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, heap, htop);
+#endif
+
+ erts_deallocate_young_generation(p);
p->heap = heap;
p->high_water = htop;
@@ -874,8 +902,6 @@ erts_garbage_collect_hibernate(Process* p)
sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm));
ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm));
- remove_message_buffers(p);
-
p->stop = p->hend = heap + heap_size;
offs = heap - p->heap;
@@ -1494,22 +1520,16 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
}
#endif
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (p->abandoned_heap
- ? p->abandoned_heap
- : HEAP_START(p)),
- HEAP_SIZE(p) * sizeof(Eterm));
- p->abandoned_heap = NULL;
- p->flags &= ~F_ABANDONED_HEAP_USE;
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, n_heap, n_htop);
+#endif
+
+ erts_deallocate_young_generation(p);
+
HEAP_START(p) = n_heap;
HEAP_TOP(p) = n_htop;
HEAP_SIZE(p) = new_sz;
HEAP_END(p) = n_heap + new_sz;
-
-#ifdef HARDDEBUG
- disallow_heap_frag_ref_in_heap(p);
-#endif
- remove_message_buffers(p);
}
/*
@@ -1598,13 +1618,12 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end,
}
#endif
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (p->abandoned_heap
- ? p->abandoned_heap
- : HEAP_START(p)),
- p->heap_sz * sizeof(Eterm));
- p->abandoned_heap = NULL;
- p->flags &= ~F_ABANDONED_HEAP_USE;
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, n_heap, n_htop);
+#endif
+
+ erts_deallocate_young_generation(p);
+
HEAP_START(p) = n_heap;
HEAP_TOP(p) = n_htop;
HEAP_SIZE(p) = new_sz;
@@ -1613,11 +1632,6 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end,
HIGH_WATER(p) = HEAP_TOP(p);
-#ifdef HARDDEBUG
- disallow_heap_frag_ref_in_heap(p);
-#endif
- remove_message_buffers(p);
-
if (p->flags & F_ON_HEAP_MSGQ)
move_msgq_to_heap(p);
@@ -1770,22 +1784,56 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
return adjusted;
}
-/*
- * Remove all message buffers.
- */
-static void
-remove_message_buffers(Process* p)
+void
+erts_deallocate_young_generation(Process *c_p)
{
- if (MBUF(p) != NULL) {
- free_message_buffer(MBUF(p));
- MBUF(p) = NULL;
+ Eterm *orig_heap;
+
+ if (!c_p->abandoned_heap) {
+ orig_heap = c_p->heap;
+ ASSERT(!(c_p->flags & F_ABANDONED_HEAP_USE));
+ }
+ else {
+ ErlHeapFragment *hfrag;
+
+ orig_heap = c_p->abandoned_heap;
+ c_p->abandoned_heap = NULL;
+ c_p->flags &= ~F_ABANDONED_HEAP_USE;
+
+ /*
+ * Temporary heap located in heap fragment
+ * only referred to by 'c_p->heap'. Add it to
+ * 'c_p->mbuf' list and deallocate it as any
+ * other heap fragment...
+ */
+ hfrag = ((ErlHeapFragment *)
+ (((char *) c_p->heap)
+ - offsetof(ErlHeapFragment, mem)));
+
+ ASSERT(!hfrag->off_heap.first);
+ ASSERT(!hfrag->off_heap.overhead);
+ ASSERT(!hfrag->next);
+ ASSERT(c_p->htop - c_p->heap <= hfrag->alloc_size);
+
+ hfrag->next = c_p->mbuf;
+ c_p->mbuf = hfrag;
+ }
+
+ if (c_p->mbuf) {
+ free_message_buffer(c_p->mbuf);
+ c_p->mbuf = NULL;
}
- if (p->msg_frag) {
- erts_cleanup_messages(p->msg_frag);
- p->msg_frag = NULL;
+ if (c_p->msg_frag) {
+ erts_cleanup_messages(c_p->msg_frag);
+ c_p->msg_frag = NULL;
}
- MBUF_SIZE(p) = 0;
+ c_p->mbuf_sz = 0;
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
+ orig_heap,
+ c_p->heap_sz * sizeof(Eterm));
}
+
#ifdef HARDDEBUG
/*
@@ -1797,19 +1845,15 @@ remove_message_buffers(Process* p)
*/
static void
-disallow_heap_frag_ref_in_heap(Process* p)
+disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop)
{
Eterm* hp;
- Eterm* htop;
- Eterm* heap;
Uint heap_size;
if (p->mbuf == 0) {
return;
}
- htop = p->htop;
- heap = p->heap;
heap_size = (htop - heap)*sizeof(Eterm);
hp = heap;
@@ -2718,7 +2762,7 @@ sweep_off_heap(Process *p, int fullsweep)
case FUN_SUBTAG:
{
ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
- if (erts_refc_dectest(&fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
erts_erase_fun_entry(fe);
}
break;
@@ -3017,6 +3061,18 @@ reply_gc_info(void *vgcirp)
reclaimed = esdp->gc_info.reclaimed;
garbage_cols = esdp->gc_info.garbage_cols;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ /*
+ * Add dirty schedulers info on requesting
+ * schedulers info
+ */
+ if (gcirp->req_sched == esdp->no) {
+ erts_mtx_lock(&dirty_gc.mtx);
+ reclaimed += dirty_gc.info.reclaimed;
+ garbage_cols += dirty_gc.info.garbage_cols;
+ erts_mtx_unlock(&dirty_gc.mtx);
+ }
+#endif
sz = 0;
hpp = NULL;
@@ -3297,13 +3353,15 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop)
ErtsMessage* mp;
Eterm *htop, *heap;
- if (p->abandoned_heap)
+ if (p->abandoned_heap) {
ERTS_GET_ORIG_HEAP(p, heap, htop);
- else {
- heap = p->heap;
- htop = real_htop ? real_htop : HEAP_TOP(p);
+ if (heap <= ptr && ptr < htop)
+ return 1;
}
+ heap = p->heap;
+ htop = real_htop ? real_htop : HEAP_TOP(p);
+
if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) {
return 1;
}
@@ -3374,12 +3432,12 @@ erts_check_off_heap2(Process *p, Eterm *htop)
refc = erts_refc_read(&u.pb->val->refc, 1);
break;
case FUN_SUBTAG:
- refc = erts_refc_read(&u.fun->fe->refc, 1);
+ refc = erts_smp_refc_read(&u.fun->fe->refc, 1);
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
- refc = erts_refc_read(&u.ext->node->refc, 1);
+ refc = erts_smp_refc_read(&u.ext->node->refc, 1);
break;
default:
ASSERT(!"erts_check_off_heap2: Invalid thing_word");
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index 54ea9ca3c0..2521379664 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -27,10 +27,6 @@
#include "erl_map.h"
-#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF
-# define HARDDEBUG 1
-#endif
-
#define IS_MOVED_BOXED(x) (!is_header((x)))
#define IS_MOVED_CONS(x) (is_non_value((x)))
@@ -157,5 +153,6 @@ void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
void erts_free_heap_frags(struct process* p);
Eterm erts_max_heap_size_map(Sint, Uint, Eterm **, Uint *);
int erts_max_heap_size(Eterm, Uint *, Uint *);
+void erts_deallocate_young_generation(Process *c_p);
#endif /* __ERL_GC_H__ */
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
index d29d079fc5..647fa26811 100644
--- a/erts/emulator/beam/erl_hl_timer.c
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -2666,7 +2666,7 @@ erts_start_timer_callback(ErtsMonotonicTime tmo,
tmo);
twt = tmo < ERTS_TIMER_WHEEL_MSEC;
- if (esdp)
+ if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp))
start_callback_timer(esdp,
twt,
timeout_pos,
@@ -2865,7 +2865,8 @@ btm_print(ErtsHLTimer *tmr, void *vbtmp)
if (tmr->timeout <= btmp->now)
left = 0;
- left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now);
+ else
+ left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now);
receiver = ((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME)
? tmr->receiver.name
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 2fd97208cc..f65a06c85f 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -117,6 +117,11 @@ const int etp_big_endian = 1;
const int etp_big_endian = 0;
#endif
const Eterm etp_the_non_value = THE_NON_VALUE;
+#ifdef ERTS_HOLE_MARKER
+const Eterm etp_hole_marker = ERTS_HOLE_MARKER;
+#else
+const Eterm etp_hole_marker = 0;
+#endif
/*
* Note about VxWorks: All variables must be initialized by executable code,
@@ -2220,7 +2225,6 @@ erl_start(int argc, char **argv)
init_break_handler();
if (replace_intr)
erts_replace_intr();
- sys_init_suspend_handler();
#endif
boot_argc = argc - i; /* Number of arguments to init */
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 06266363b5..5d4823c077 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -129,6 +129,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "run_queue", "address" },
#ifdef ERTS_DIRTY_SCHEDULERS
{ "dirty_run_queue_sleep_list", "address" },
+ { "dirty_gc_info", NULL },
+ { "dirty_break_point_index", NULL },
#endif
{ "process_table", NULL },
{ "cpu_info", NULL },
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index e4c696ae3b..019e079e67 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -172,7 +172,7 @@ erts_cleanup_offheap(ErlOffHeap *offheap)
}
break;
case FUN_SUBTAG:
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
@@ -193,7 +193,7 @@ free_message_buffer(ErlHeapFragment* bp)
erts_cleanup_offheap(&bp->off_heap);
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp,
- ERTS_HEAP_FRAG_SIZE(bp->size));
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size));
bp = next_bp;
}while (bp != NULL);
}
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index 910598690d..c207dea10f 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -104,7 +104,7 @@ do { \
(*((Hp)++)) = boxed_val((From))[i__]; \
if (is_external((To))) { \
external_thing_ptr((To))->next = NULL; \
- erts_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\
+ erts_smp_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\
} \
} \
} while (0)
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 6b265a8b80..4fa15a8dd8 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -690,7 +690,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
Uint sz = size_object(msg);
ErlOffHeap *ohp;
Eterm *hp;
- if (env && !env->tracee) {
+ if (c_p && !env->tracee) {
full_flush_env(env);
mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
full_cache_env(env);
@@ -3561,8 +3561,8 @@ Eterm erts_nif_call_function(Process *p, Process *tracee,
#endif
if (p) {
/* This is almost a normal nif call like in beam_emu,
- except that any heap fragment created in the nif will be
- discarded without checking if anything in it is live.
+ except that any heap consumed by the nif will be
+ released without checking if anything in it is live.
This is because we cannot do a GC here as we don't know
the number of live registers that have to be preserved.
This means that any heap part of the returned term may
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 70500ed6e1..467a05f950 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -98,7 +98,7 @@ dist_table_alloc(void *dep_tmpl)
dist_entries++;
dep->prev = NULL;
- erts_refc_init(&dep->refc, -1);
+ erts_smp_refc_init(&dep->refc, -1);
erts_smp_rwmtx_init_opt_x(&dep->rwmtx, &rwmtx_opt, "dist_entry", chnl_nr);
dep->sysname = sysname;
dep->cid = NIL;
@@ -208,7 +208,7 @@ erts_channel_no_to_dist_entry(Uint cno)
* to the node name is used as channel no.
*/
if(cno == ERST_INTERNAL_CHANNEL_NO) {
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
return erts_this_dist_entry;
}
@@ -231,16 +231,16 @@ erts_sysname_to_connected_dist_entry(Eterm sysname)
de.sysname = sysname;
if(erts_this_dist_entry->sysname == sysname) {
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
return erts_this_dist_entry;
}
erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de);
if (res_dep) {
- erts_aint_t refc = erts_refc_inctest(&res_dep->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&res_dep->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&res_dep->refc, 1);
+ erts_smp_refc_inc(&res_dep->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
if (res_dep) {
@@ -267,9 +267,9 @@ DistEntry *erts_find_or_insert_dist_entry(Eterm sysname)
de.sysname = sysname;
erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
res = hash_put(&erts_dist_table, (void *) &de);
- refc = erts_refc_inctest(&res->refc, 0);
+ refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
return res;
}
@@ -282,9 +282,9 @@ DistEntry *erts_find_dist_entry(Eterm sysname)
erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
res = hash_get(&erts_dist_table, (void *) &de);
if (res) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
return res;
@@ -311,7 +311,7 @@ static void try_delete_dist_entry(void *vdep)
*
* If refc > 0, the entry is in use. Keep the entry.
*/
- refc = erts_refc_dectest(&dep->refc, -1);
+ refc = erts_smp_refc_dectest(&dep->refc, -1);
if (refc == -1)
(void) hash_erase(&erts_dist_table, (void *) dep);
erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
@@ -518,7 +518,7 @@ node_table_alloc(void *venp_tmpl)
node_entries++;
- erts_refc_init(&enp->refc, -1);
+ erts_smp_refc_init(&enp->refc, -1);
enp->creation = ((ErlNode *) venp_tmpl)->creation;
enp->sysname = ((ErlNode *) venp_tmpl)->sysname;
enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname);
@@ -585,9 +585,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
res = hash_get(&erts_node_table, (void *) &ne);
if (res && res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
if (res)
@@ -597,9 +597,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
res = hash_put(&erts_node_table, (void *) &ne);
ASSERT(res);
if (res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
return res;
@@ -626,7 +626,7 @@ static void try_delete_node(void *venp)
*
* If refc > 0, the entry is in use. Keep the entry.
*/
- refc = erts_refc_dectest(&enp->refc, -1);
+ refc = erts_smp_refc_dectest(&enp->refc, -1);
if (refc == -1)
(void) hash_erase(&erts_node_table, (void *) enp);
erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
@@ -672,7 +672,7 @@ static void print_node(void *venp, void *vpndp)
erts_print(pndp->to, pndp->to_arg, " %d", enp->creation);
#ifdef DEBUG
erts_print(pndp->to, pndp->to_arg, " (refc=%ld)",
- erts_refc_read(&enp->refc, 0));
+ erts_smp_refc_read(&enp->refc, 0));
#endif
pndp->no_sysname++;
}
@@ -715,19 +715,19 @@ void
erts_set_this_node(Eterm sysname, Uint creation)
{
ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking());
- ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2));
+ ASSERT(erts_smp_refc_read(&erts_this_dist_entry->refc, 2));
- if (erts_refc_dectest(&erts_this_node->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&erts_this_node->refc, 0) == 0)
try_delete_node(erts_this_node);
- if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&erts_this_dist_entry->refc, 0) == 0)
try_delete_dist_entry(erts_this_dist_entry);
erts_this_node = NULL; /* to make sure refc is bumped for this node */
erts_this_node = erts_find_or_insert_node(sysname, creation);
erts_this_dist_entry = erts_this_node->dist_entry;
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
erts_this_node_sysname = erts_this_node_sysname_BUFFER;
erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
@@ -789,13 +789,13 @@ void erts_init_node_tables(int dd_sec)
node_tmpl.creation = 0;
erts_this_node = hash_put(&erts_node_table, &node_tmpl);
/* +1 for erts_this_node */
- erts_refc_init(&erts_this_node->refc, 1);
+ erts_smp_refc_init(&erts_this_node->refc, 1);
ASSERT(erts_this_node->dist_entry != NULL);
erts_this_dist_entry = erts_this_node->dist_entry;
/* +1 for erts_this_dist_entry */
/* +1 for erts_this_node->dist_entry */
- erts_refc_init(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_init(&erts_this_dist_entry->refc, 2);
erts_this_node_sysname = erts_this_node_sysname_BUFFER;
@@ -1623,7 +1623,7 @@ reference_table_term(Uint **hpp, Uint *szp)
tup = MK_2TUP(referred_nodes[i].node->sysname,
MK_UINT(referred_nodes[i].node->creation));
- tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 0)), nril);
+ tup = MK_3TUP(tup, MK_UINT(erts_smp_refc_read(&referred_nodes[i].node->refc, 0)), nril);
nl = MK_CONS(tup, nl);
}
@@ -1684,7 +1684,7 @@ reference_table_term(Uint **hpp, Uint *szp)
/* DistList = [{Dist, Refc, ReferenceIdList}] */
tup = MK_3TUP(referred_dists[i].dist->sysname,
- MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 0)),
+ MK_UINT(erts_smp_refc_read(&referred_dists[i].dist->refc, 0)),
dril);
dl = MK_CONS(tup, dl);
}
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index 47a6724c21..35051173d0 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -107,7 +107,7 @@ typedef struct dist_entry_ {
HashBucket hash_bucket; /* Hash bucket */
struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */
struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */
- erts_refc_t refc; /* Reference count */
+ erts_smp_refc_t refc; /* Reference count */
erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */
Eterm sysname; /* name@host atom for efficiency */
@@ -149,7 +149,7 @@ typedef struct dist_entry_ {
typedef struct erl_node_ {
HashBucket hash_bucket; /* Hash bucket */
- erts_refc_t refc; /* Reference count */
+ erts_smp_refc_t refc; /* Reference count */
Eterm sysname; /* name@host atom for efficiency */
Uint32 creation; /* Creation */
DistEntry *dist_entry; /* Corresponding dist entry */
@@ -210,7 +210,7 @@ ERTS_GLB_INLINE void
erts_deref_dist_entry(DistEntry *dep)
{
ASSERT(dep);
- if (erts_refc_dectest(&dep->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&dep->refc, 0) == 0)
erts_schedule_delete_dist_entry(dep);
}
@@ -218,7 +218,7 @@ ERTS_GLB_INLINE void
erts_deref_node_entry(ErlNode *np)
{
ASSERT(np);
- if (erts_refc_dectest(&np->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&np->refc, 0) == 0)
erts_schedule_delete_node(np);
}
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index b345c35a7e..485949c84a 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -2060,6 +2060,7 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait
#endif
for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) {
ErtsThrPrgrLaterOp *lop = awdp->later_op.first;
+
if (!erts_thr_progress_has_reached_this(current, lop->later))
return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP;
awdp->later_op.first = lop->next;
@@ -6234,6 +6235,12 @@ check_dirty_enqueue_in_prio_queue(Process *c_p,
int queue;
erts_aint32_t dact, max_qbit;
+ /* Do not enqueue free process... */
+ if (actual & ERTS_PSFLG_FREE) {
+ *newp &= ~ERTS_PSFLGS_DIRTY_WORK;
+ return ERTS_ENQUEUE_NOT;
+ }
+
/* Termination should be done on an ordinary scheduler */
if ((*newp) & ERTS_PSFLG_EXITING) {
*newp &= ~ERTS_PSFLGS_DIRTY_WORK;
@@ -6426,6 +6433,9 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st
/*
* schedule_out_process() return with c_rq locked.
+ *
+ * Return non-zero value if caller should decrease
+ * reference count on the process when done with it...
*/
static ERTS_INLINE int
schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
@@ -6480,12 +6490,18 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
erts_smp_runq_lock(c_rq);
- return 0;
-
+#if !defined(ERTS_SMP)
+ /* Decrement refc if process struct is free... */
+ return !!(n & ERTS_PSFLG_FREE);
+#else
+ /* Decrement refc if scheduled out from dirty scheduler... */
+ return !is_normal_sched;
+#endif
}
else {
Process* sched_p;
+ ASSERT(!(n & ERTS_PSFLG_FREE));
ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_DIRTY_ACTIVE_SYS)));
@@ -6501,11 +6517,14 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
erts_smp_runq_lock(runq);
+ if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
+ erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */
+
/* Enqueue the process */
enqueue_process(runq, (int) enq_prio, sched_p);
if (runq == c_rq)
- return 1;
+ return 0;
erts_smp_runq_unlock(runq);
@@ -6513,9 +6532,15 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
erts_smp_runq_lock(c_rq);
- return 1;
+ /*
+ * Decrement refc if process is scheduled out by a
+ * dirty scheduler, and we have not just scheduled
+ * the process using the ordinary process struct
+ * on a dirty run-queue again...
+ */
+ return !is_normal_sched && (sched_p != p
+ || !ERTS_RUNQ_IX_IS_DIRTY(runq->ix));
}
-
}
static ERTS_INLINE void
@@ -6530,8 +6555,17 @@ add2runq(int enqueue, erts_aint32_t prio,
if (runq) {
Process *sched_p;
- if (enqueue > 0)
+ if (enqueue > 0) {
sched_p = proc;
+ /*
+ * Refc on process struct (i.e. true struct,
+ * not proxy-struct) increased while in a
+ * dirty run-queue or executing on a dirty
+ * scheduler.
+ */
+ if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
+ erts_proc_inc_refc(proc);
+ }
else {
Process *pxy;
@@ -7055,12 +7089,18 @@ typedef struct {
} ErtsSchdlrSspndResume;
static void
-schdlr_sspnd_resume_proc(Eterm pid)
+schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid)
{
- Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS);
+ Process *p;
+ p = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_STATUS,
+ (sched_type != ERTS_SCHED_NORMAL
+ ? ERTS_P2P_FLG_INC_REFC
+ : 0));
if (p) {
resume_process(p, ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ if (sched_type != ERTS_SCHED_NORMAL)
+ erts_proc_dec_refc(p);
}
}
@@ -7069,17 +7109,20 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type,
ErtsSchdlrSspndResume *resume)
{
if (is_internal_pid(resume->onln.chngr)) {
- schdlr_sspnd_resume_proc(resume->onln.chngr);
+ schdlr_sspnd_resume_proc(sched_type,
+ resume->onln.chngr);
resume->onln.chngr = NIL;
}
if (is_internal_pid(resume->onln.nxt)) {
- schdlr_sspnd_resume_proc(resume->onln.nxt);
+ schdlr_sspnd_resume_proc(sched_type,
+ resume->onln.nxt);
resume->onln.nxt = NIL;
}
while (resume->msb.chngrs) {
ErtsProcList *plp = resume->msb.chngrs;
resume->msb.chngrs = plp->next;
- schdlr_sspnd_resume_proc(plp->pid);
+ schdlr_sspnd_resume_proc(sched_type,
+ plp->pid);
proclist_destroy(plp);
}
}
@@ -7131,16 +7174,8 @@ suspend_scheduler(ErtsSchedulerData *esdp)
ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1);
- if (sched_type != ERTS_SCHED_NORMAL) {
- if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) {
- erts_smp_runq_unlock(esdp->run_queue);
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- erts_smp_runq_lock(esdp->run_queue);
- }
- if (schdlr_sspnd.msb.ongoing)
- evacuate_run_queue(esdp->run_queue, &sbp);
+ if (sched_type != ERTS_SCHED_NORMAL)
erts_smp_runq_unlock(esdp->run_queue);
- }
else {
evacuate_run_queue(esdp->run_queue, &sbp);
@@ -7153,8 +7188,8 @@ suspend_scheduler(ErtsSchedulerData *esdp)
sched_wall_time_change(esdp, 0);
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
}
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED);
if (flgs & ERTS_SSI_FLG_SUSPENDED) {
@@ -7198,15 +7233,18 @@ suspend_scheduler(ErtsSchedulerData *esdp)
(void) erts_proclist_fetch(&msb[i]->chngq, &end_plp);
/* resume processes that initiated the multi scheduling block... */
plp = msb[i]->chngq;
- while (plp) {
- erts_proclist_store_last(&msb[i]->blckrs,
- proclist_copy(plp));
- plp = plp->next;
- }
- if (end_plp)
+ if (plp) {
+ ASSERT(end_plp);
+ ASSERT(msb[i]->ongoing);
+ do {
+ erts_proclist_store_last(&msb[i]->blckrs,
+ proclist_copy(plp));
+ plp = plp->next;
+ } while (plp);
end_plp->next = resume.msb.chngrs;
- resume.msb.chngrs = msb[i]->chngq;
- msb[i]->chngq = NULL;
+ resume.msb.chngrs = msb[i]->chngq;
+ msb[i]->chngq = NULL;
+ }
}
}
}
@@ -7270,24 +7308,14 @@ suspend_scheduler(ErtsSchedulerData *esdp)
while (1) {
ErtsMonotonicTime current_time;
- erts_aint32_t qmask;
erts_aint32_t flgs;
- qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue)
- & ERTS_RUNQ_FLGS_QMASK);
-
- if (sched_type != ERTS_SCHED_NORMAL) {
- if (qmask) {
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- erts_smp_runq_lock(esdp->run_queue);
- if (schdlr_sspnd.msb.ongoing)
- evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- }
+ if (sched_type != ERTS_SCHED_NORMAL)
aux_work = 0;
- }
else {
+ erts_aint32_t qmask;
+ qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue)
+ & ERTS_RUNQ_FLGS_QMASK);
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
@@ -7415,12 +7443,23 @@ suspend_scheduler(ErtsSchedulerData *esdp)
schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type);
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
- && schdlr_sspnd.online == schdlr_sspnd.active) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_MSB);
- }
-
+ if (changing) {
+ if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
+ && !schdlr_sspnd.msb.ongoing
+ && schdlr_sspnd.online == schdlr_sspnd.active) {
+ erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~ERTS_SCHDLR_SSPND_CHNG_MSB);
+ }
+ if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB)
+ && !schdlr_sspnd.nmsb.ongoing
+ && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL)
+ == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL))) {
+ erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~ERTS_SCHDLR_SSPND_CHNG_NMSB);
+ }
+ }
ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type));
ASSERT((sched_type == ERTS_SCHED_NORMAL
? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)
@@ -7553,7 +7592,7 @@ abort_sched_onln_chng_waitq(Process *p)
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
if (is_internal_pid(resume))
- schdlr_sspnd_resume_proc(resume);
+ schdlr_sspnd_resume_proc(ERTS_SCHED_NORMAL, resume);
}
ErtsSchedSuspendResult
@@ -7951,21 +7990,20 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
}
else { /* ------ UNBLOCK ------ */
if (p->flags & have_blckd_flg) {
- ErtsProcList *plps[2];
+ ErtsProcList **plpps[3] = {0};
ErtsProcList *plp;
- int limit = 0;
- plps[limit++] = erts_proclist_peek_first(msbp->blckrs);
- if (all)
- plps[limit++] = erts_proclist_peek_first(msbp->chngq);
+ plpps[0] = &msbp->blckrs;
+ if (all)
+ plpps[1] = &msbp->chngq;
- for (ix = 0; ix < limit; ix++) {
- plp = plps[ix];
+ for (ix = 0; plpps[ix]; ix++) {
+ plp = erts_proclist_peek_first(*plpps[ix]);
while (plp) {
ErtsProcList *tmp_plp = plp;
- plp = erts_proclist_peek_next(msbp->blckrs, plp);
+ plp = erts_proclist_peek_next(*plpps[ix], plp);
if (erts_proclist_same(tmp_plp, p)) {
- erts_proclist_remove(&msbp->blckrs, tmp_plp);
+ erts_proclist_remove(plpps[ix], tmp_plp);
proclist_destroy(tmp_plp);
if (!all)
break;
@@ -8604,8 +8642,15 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
* from being selected for normal execution regardless
* of locks held or not held on it...
*/
- ASSERT(!((ERTS_PSFLG_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS)
- & erts_smp_atomic32_read_nob(&rp->state)));
+#ifdef DEBUG
+ {
+ erts_aint32_t state;
+ state = erts_smp_atomic32_read_nob(&rp->state);
+ ASSERT((state & ERTS_PSFLG_PENDING_EXIT)
+ || !(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)));
+ }
+#endif
if (!suspend)
resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS);
@@ -9587,40 +9632,46 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
esdp->reductions += reds;
- /* schedule_out_process() returns with rq locked! */
- schedule_out_process(rq, state, p, proxy_p, is_normal_sched);
- proxy_p = NULL;
+ {
+ int dec_refc;
+
+ /* schedule_out_process() returns with rq locked! */
+ dec_refc = schedule_out_process(rq, state, p,
+ proxy_p, is_normal_sched);
+ proxy_p = NULL;
- ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq,
- (int) ERTS_PSFLGS_GET_USR_PRIO(state),
- reds,
- actual_reds);
+ ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq,
+ (int) ERTS_PSFLGS_GET_USR_PRIO(state),
+ reds,
+ actual_reds);
- esdp->current_process = NULL;
+ esdp->current_process = NULL;
#ifdef ERTS_SMP
- p->scheduler_data = NULL;
+ if (is_normal_sched)
+ p->scheduler_data = NULL;
#endif
- erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_STATUS
- | ERTS_PROC_LOCK_TRACE));
+ erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_STATUS
+ | ERTS_PROC_LOCK_TRACE));
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
- if (state & ERTS_PSFLG_FREE) {
- if (!is_normal_sched) {
- ASSERT(p->flags & F_DELAYED_DEL_PROC);
- erts_proc_dec_refc(p);
- }
- else {
#ifdef ERTS_SMP
- ASSERT(esdp->free_process == p);
- esdp->free_process = NULL;
-#else
- erts_proc_dec_refc(p);
+ if (state & ERTS_PSFLG_FREE) {
+ if (!is_normal_sched) {
+ ASSERT(p->flags & F_DELAYED_DEL_PROC);
+ }
+ else {
+ ASSERT(esdp->free_process == p);
+ esdp->free_process = NULL;
+ }
+ }
#endif
- }
- }
+
+ if (dec_refc)
+ erts_proc_dec_refc(p);
+ }
#ifdef ERTS_SMP
ASSERT(!esdp->free_process);
@@ -9896,8 +9947,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
if (!(state & ERTS_PSFLG_PROXY))
psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ;
else {
+ Eterm pid = p->common.id;
proxy_p = p;
- p = erts_proc_lookup_raw(proxy_p->common.id);
+ p = (is_normal_sched
+ ? erts_proc_lookup_raw(pid)
+ : erts_pid2proc_opt(NULL, 0, pid, 0,
+ ERTS_P2P_FLG_INC_REFC));
if (!p) {
free_proxy_proc(proxy_p);
proxy_p = NULL;
@@ -9929,6 +9984,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
| ERTS_PSFLG_FREE)))
#ifdef ERTS_DIRTY_SCHEDULERS
| (((state & (ERTS_PSFLG_RUNNING
+
| ERTS_PSFLG_FREE
| ERTS_PSFLG_RUNNING_SYS
| ERTS_PSFLG_EXITING))
@@ -9961,6 +10017,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
/* free and not queued by proxy */
erts_proc_dec_refc(p);
}
+ if (!is_normal_sched)
+ erts_proc_dec_refc(p);
goto pick_next_process;
}
state = new;
@@ -10013,8 +10071,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
state = erts_smp_atomic32_read_nob(&p->state);
- ASSERT(!p->scheduler_data);
#ifndef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!p->scheduler_data);
p->scheduler_data = esdp;
#else /* ERTS_DIRTY_SCHEDULERS */
if (is_normal_sched) {
@@ -10025,6 +10083,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
goto sched_out_proc;
}
+ ASSERT(!p->scheduler_data);
p->scheduler_data = esdp;
}
else {
@@ -11912,7 +11971,6 @@ erts_cleanup_empty_process(Process* p)
static void
delete_process(Process* p)
{
- Eterm *heap;
ErtsPSD *psd;
struct saved_calls *scb;
process_breakpoint_time_t *pbt;
@@ -11967,13 +12025,8 @@ delete_process(Process* p)
hipe_delete_process(&p->hipe);
#endif
- heap = p->abandoned_heap ? p->abandoned_heap : p->heap;
-
-#ifdef DEBUG
- sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm));
-#endif
+ erts_deallocate_young_generation(p);
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm));
if (p->old_heap != NULL) {
#ifdef DEBUG
@@ -11985,16 +12038,6 @@ delete_process(Process* p)
(p->old_hend-p->old_heap)*sizeof(Eterm));
}
- /*
- * Free all pending message buffers.
- */
- if (p->mbuf != NULL) {
- free_message_buffer(p->mbuf);
- }
-
- if (p->msg_frag)
- erts_cleanup_messages(p->msg_frag);
-
erts_erase_dicts(p);
/* free all pending messages */
@@ -13091,15 +13134,14 @@ erts_continue_exit_process(Process *p)
}
#ifdef ERTS_DIRTY_SCHEDULERS
- if (a & (ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ if (a & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
p->flags |= F_DELAYED_DEL_PROC;
delay_del_proc = 1;
/*
- * The dirty scheduler will also decrease
- * refc when done...
+ * The dirty scheduler decrease refc
+ * when done with the process...
*/
- erts_proc_inc_refc(p);
}
#endif
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 9f7084c127..68fbb10602 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1684,7 +1684,7 @@ ERTS_GLB_INLINE ErtsProcList *erts_proclist_fetch_first(ErtsProcList **list)
return NULL;
else {
ErtsProcList *res = *list;
- if (res == *list)
+ if (res->next == *list)
*list = NULL;
else
*list = res->next;
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index d8bb00e8c6..4a74cc2b82 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -90,9 +90,12 @@ Uint erts_process_memory(Process *p, int incl_msg_inq) {
erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size);
erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size);
size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
+ if (p->abandoned_heap)
+ size += (p->hend - p->heap) * sizeof(Eterm);
if (p->old_hend && p->old_heap)
size += (p->old_hend - p->old_heap) * sizeof(Eterm);
+
size += p->msg.len * sizeof(ErtsMessage);
for (mp = p->msg.first; mp; mp = mp->next)
@@ -443,7 +446,7 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x)
ProcBin* pb = (ProcBin *) binary_val(x);
Binary* val = pb->val;
- if (erts_smp_atomic_xchg_nob(&val->refc, 0) != 0) {
+ if (erts_atomic_xchg_nob(&val->refc, 0) != 0) {
val->flags = (UWord) all_binaries;
all_binaries = val;
}
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 8c84303997..ac9e91e31f 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -1436,6 +1436,7 @@ void
trace_gc(Process *p, Eterm what, Uint size, Eterm msg)
{
ErtsTracerNif *tnif = NULL;
+ Eterm* o_hp = NULL;
Eterm* hp;
Uint sz = 0;
Eterm tup;
@@ -1446,7 +1447,7 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg)
if (is_non_value(msg)) {
(void) erts_process_gc_info(p, &sz, NULL, 0, 0);
- hp = HAlloc(p, sz + 3 + 2);
+ o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, (sz + 3 + 2) * sizeof(Eterm));
msg = erts_process_gc_info(p, NULL, &hp, 0, 0);
tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3;
@@ -1455,6 +1456,8 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg)
send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC,
what, msg, THE_NON_VALUE, am_true);
+ if (o_hp)
+ erts_free(ERTS_ALC_T_TMP, o_hp);
}
}
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index f97716d030..899e2a275a 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -110,8 +110,21 @@
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
-# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef)
-#endif /* egil: 32-bit ? */
+
+/*
+ * ERTS_HOLE_MARKER must *not* be mistaken for a valid term
+ * on the heap...
+ */
+# ifdef ARCH_64
+# define ERTS_HOLE_MARKER \
+ make_catch(UWORD_CONSTANT(0xdeadbeaf00000000) >> _TAG_IMMED2_SIZE)
+/* Will (at the time of writing) appear as 0xdeadbeaf0000001b */
+# else
+# define ERTS_HOLE_MARKER \
+ make_catch(UWORD_CONSTANT(0xdead0000) >> _TAG_IMMED2_SIZE)
+/* Will (at the time of writing) appear as 0xdead001b */
+# endif
+#endif
/*
* Allocate heap memory on the ordinary heap, NEVER in a heap
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 7f043e191b..00fa452f79 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -348,7 +348,7 @@ Export *export_list(int i, ErtsCodeIndex code_ix)
int export_list_size(ErtsCodeIndex code_ix)
{
- return export_tables[code_ix].entries;
+ return erts_index_num_entries(&export_tables[code_ix]);
}
int export_table_sz(void)
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index beed847578..0ef8114bac 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -616,7 +616,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize)
sys_memcpy((void *) ep, (void *) edep, dist_ext_sz);
ep += dist_ext_sz;
if (new_edep->dep)
- erts_refc_inc(&new_edep->dep->refc, 1);
+ erts_smp_refc_inc(&new_edep->dep->refc, 1);
new_edep->extp = ep;
new_edep->ext_endp = ep + ext_sz;
new_edep->heap_size = -1;
@@ -1222,6 +1222,7 @@ typedef struct B2TContext_t {
} u;
} B2TContext;
+static B2TContext* b2t_export_context(Process*, B2TContext* src);
static uLongf binary2term_uncomp_size(byte* data, Sint size)
{
@@ -1254,7 +1255,7 @@ static uLongf binary2term_uncomp_size(byte* data, Sint size)
static ERTS_INLINE int
binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
- B2TContext* ctx)
+ B2TContext** ctxp, Process* p)
{
byte *bytes = data;
Sint size = data_size;
@@ -1268,8 +1269,8 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
size--;
if (size < 5 || *bytes != COMPRESSED) {
state->extp = bytes;
- if (ctx)
- ctx->state = B2TSizeInit;
+ if (ctxp)
+ (*ctxp)->state = B2TSizeInit;
}
else {
uLongf dest_len = (Uint32) get_int32(bytes+1);
@@ -1286,16 +1287,26 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
return -1;
}
state->extp = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA, dest_len);
- ctx->reds -= dest_len;
+ if (ctxp)
+ (*ctxp)->reds -= dest_len;
}
state->exttmp = 1;
- if (ctx) {
+ if (ctxp) {
+ /*
+ * Start decompression by exporting trap context
+ * so we don't have to deal with deep-copying z_stream.
+ */
+ B2TContext* ctx = b2t_export_context(p, *ctxp);
+ ASSERT(state = &(*ctxp)->b2ts);
+ state = &ctx->b2ts;
+
if (erl_zlib_inflate_start(&ctx->u.uc.stream, bytes, size) != Z_OK)
return -1;
ctx->u.uc.dbytes = state->extp;
ctx->u.uc.dleft = dest_len;
ctx->state = B2TUncompressChunk;
+ *ctxp = ctx;
}
else {
uLongf dlen = dest_len;
@@ -1339,7 +1350,7 @@ erts_binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size
{
Sint res;
- if (binary2term_prepare(state, data, data_size, NULL) < 0 ||
+ if (binary2term_prepare(state, data, data_size, NULL, NULL) < 0 ||
(res=decoded_size(state->extp, state->extp + state->extsize, 0, NULL)) < 0) {
if (state->exttmp)
@@ -1485,7 +1496,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
if (ctx->aligned_alloc) {
ctx->reds -= bin_size / 8;
}
- if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, ctx) < 0) {
+ if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, &ctx, p) < 0) {
ctx->state = B2TBadArg;
}
break;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index d6df85034c..26aa39b65a 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -127,7 +127,7 @@ typedef struct {
void *handle; /* Handle for DLL or SO (for dyn. drivers). */
DE_ProcEntry *procs; /* List of pids that have loaded this driver,
or that wait for it to change state */
- erts_refc_t refc; /* Number of ports/processes having
+ erts_smp_refc_t refc; /* Number of ports/processes having
references to the driver */
erts_smp_atomic32_t port_count; /* Number of ports using the driver */
Uint flags; /* ERL_DE_FL_KILL_PORTS */
diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c
index c86a2122f6..cd834e2c12 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -91,9 +91,16 @@ index_put_entry(IndexTable* t, void* tmpl)
t->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(t->type, sz);
t->size += INDEX_PAGE_SIZE;
}
- t->entries++;
p->index = ix;
t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p;
+
+ /*
+ * Do a write barrier here to allow readers to do lock free iteration.
+ * erts_index_num_entries() does matching read barrier.
+ */
+ ERTS_SMP_WRITE_MEMORY_BARRIER;
+ t->entries++;
+
return p;
}
diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h
index b2e3c0eab5..10f5d1eb39 100644
--- a/erts/emulator/beam/index.h
+++ b/erts/emulator/beam/index.h
@@ -65,6 +65,7 @@ void index_erase_latest_from(IndexTable*, Uint ix);
ERTS_GLB_INLINE int index_put(IndexTable*, void*);
ERTS_GLB_INLINE IndexSlot* erts_index_lookup(IndexTable*, Uint);
+ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -78,6 +79,19 @@ erts_index_lookup(IndexTable* t, Uint ix)
{
return t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK];
}
+
+ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t)
+{
+ int ret = t->entries;
+ /*
+ * Do a read barrier here to allow lock free iteration
+ * on tables where entries are never erased.
+ * index_put_entry() does matching write barrier.
+ */
+ ERTS_SMP_READ_MEMORY_BARRIER;
+ return ret;
+}
+
#endif
#endif
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 4f131c74de..38e403d91a 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -4884,10 +4884,24 @@ erts_port_control(Process* c_p,
ASSERT(!tmp_alloced);
if (*ebinp == HEADER_SUB_BIN)
ebinp = binary_val(((ErlSubBin *) ebinp)->orig);
+
if (*ebinp != HEADER_PROC_BIN)
copy = 1;
else {
- binp = ((ProcBin *) ebinp)->val;
+ ProcBin *pb = (ProcBin *) ebinp;
+ int offset = bufp - pb->val->orig_bytes;
+
+ ASSERT(pb->val->orig_bytes <= bufp
+ && bufp + size <= pb->val->orig_bytes + pb->val->orig_size);
+
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+
+ /* The procbin may have been reallocated, so update bufp */
+ bufp = pb->val->orig_bytes + offset;
+ }
+
+ binp = pb->val;
ASSERT(bufp <= bufp + size);
ASSERT(binp->orig_bytes <= bufp
&& bufp + size <= binp->orig_bytes + binp->orig_size);
@@ -6890,12 +6904,6 @@ ErlDrvSizeT driver_vec_to_buf(ErlIOVec *vec, char *buf, ErlDrvSizeT len)
return (orig_len - len);
}
-
-/*
- * - driver_alloc_binary() is thread safe (efile driver depend on it).
- * - driver_realloc_binary(), and driver_free_binary() are *not* thread safe.
- */
-
/*
* reference count on driver binaries...
*/
@@ -6938,26 +6946,15 @@ driver_alloc_binary(ErlDrvSizeT size)
return Binary2ErlDrvBinary(bin);
}
-/* Reallocate space hold by binary */
+/* Reallocate space held by binary */
ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size)
{
Binary* oldbin;
Binary* newbin;
- if (!bin) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Bad use of driver_realloc_binary(%p, %lu): "
- "called with ",
- bin, (unsigned long)size);
- if (!bin) {
- erts_dsprintf(dsbufp, "NULL pointer as first argument");
- }
- erts_send_warning_to_logger_nogl(dsbufp);
- if (!bin)
- return driver_alloc_binary(size);
- }
+ if (!bin)
+ return driver_alloc_binary(size);
oldbin = ErlDrvBinary2Binary(bin);
newbin = (Binary *) erts_bin_realloc_fnf(oldbin, size);
@@ -6971,14 +6968,8 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size)
void driver_free_binary(ErlDrvBinary* dbin)
{
Binary *bin;
- if (!dbin) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Bad use of driver_free_binary(%p): called with "
- "NULL pointer as argument", dbin);
- erts_send_warning_to_logger_nogl(dsbufp);
+ if (!dbin)
return;
- }
bin = ErlDrvBinary2Binary(dbin);
if (erts_refc_dectest(&bin->refc, 0) == 0)
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 7740dd4373..79ec34e717 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -859,9 +859,12 @@ int erts_sys_unsetenv(char *key);
char *erts_read_env(char *key);
void erts_free_read_env(void *value);
+#if defined(ERTS_SMP)
#if defined(ERTS_THR_HAVE_SIG_FUNCS) && !defined(ETHR_UNUSABLE_SIGUSRX)
extern void sys_thr_resume(erts_tid_t tid);
extern void sys_thr_suspend(erts_tid_t tid);
+#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2
+#endif
#endif
/* utils.c */
@@ -894,7 +897,7 @@ void sys_alloc_stat(SysAllocStat *);
#define ERTS_REFC_DEBUG
#endif
-typedef erts_smp_atomic_t erts_refc_t;
+typedef erts_atomic_t erts_refc_t;
ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val);
ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val);
@@ -913,27 +916,27 @@ ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp,
ERTS_GLB_INLINE void
erts_refc_init(erts_refc_t *refcp, erts_aint_t val)
{
- erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val);
+ erts_atomic_init_nob((erts_atomic_t *) refcp, val);
}
ERTS_GLB_INLINE void
erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val)
{
#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
+ erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp);
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
"erts_refc_inc(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#else
- erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp);
+ erts_atomic_inc_nob((erts_atomic_t *) refcp);
#endif
}
ERTS_GLB_INLINE erts_aint_t
erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val)
{
- erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
+ erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
@@ -947,20 +950,20 @@ ERTS_GLB_INLINE void
erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val)
{
#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
+ erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp);
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
"erts_refc_dec(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#else
- erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp);
+ erts_atomic_dec_nob((erts_atomic_t *) refcp);
#endif
}
ERTS_GLB_INLINE erts_aint_t
erts_refc_dectest(erts_refc_t *refcp, erts_aint_t min_val)
{
- erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
+ erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
@@ -974,20 +977,20 @@ ERTS_GLB_INLINE void
erts_refc_add(erts_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val)
{
#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff);
+ erts_aint_t val = erts_atomic_add_read_nob((erts_atomic_t *) refcp, diff);
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
"erts_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n",
diff, val, min_val);
#else
- erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff);
+ erts_atomic_add_nob((erts_atomic_t *) refcp, diff);
#endif
}
ERTS_GLB_INLINE erts_aint_t
erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val)
{
- erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
+ erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
erts_exit(ERTS_ABORT_EXIT,
@@ -999,6 +1002,112 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+typedef erts_smp_atomic_t erts_smp_refc_t;
+
+ERTS_GLB_INLINE void erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val);
+ERTS_GLB_INLINE void erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inctest(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE void erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_dectest(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE void erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_read(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val)
+{
+ erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val);
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val)
+{
+#ifdef ERTS_REFC_DEBUG
+ erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_inc(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#else
+ erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_inctest(erts_smp_refc_t *refcp, erts_aint_t min_val)
+{
+ erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
+#ifdef ERTS_REFC_DEBUG
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val)
+{
+#ifdef ERTS_REFC_DEBUG
+ erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_dec(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#else
+ erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_dectest(erts_smp_refc_t *refcp, erts_aint_t min_val)
+{
+ erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
+#ifdef ERTS_REFC_DEBUG
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val)
+{
+#ifdef ERTS_REFC_DEBUG
+ erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff);
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n",
+ diff, val, min_val);
+#else
+ erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_read(erts_smp_refc_t *refcp, erts_aint_t min_val)
+{
+ erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
+#ifdef ERTS_REFC_DEBUG
+ if (val < min_val)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_read(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+
#ifdef ERTS_ENABLE_KERNEL_POLL
extern int erts_use_kernel_poll;
#endif
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 87ea4f05a1..7f7e38c22a 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -3842,7 +3842,7 @@ store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns)
for(i = 0; i < size; i++)
to_hp[i] = from_hp[i];
- erts_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2);
+ erts_smp_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2);
((struct erl_off_heap_header*) to_hp)->next = oh->first;
oh->first = (struct erl_off_heap_header*) to_hp;
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index bfe0807df8..3ff68a8859 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
+ * Copyright Ericsson AB 1997-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.
@@ -79,11 +79,10 @@
* Macros for testing file types.
*/
-#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR)
-#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG)
-#define ISDEV(st) \
- (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK)
-#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK)
+#define ISDIR(st) (S_ISDIR((st).st_mode))
+#define ISREG(st) (S_ISREG((st).st_mode))
+#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode))
+#define ISLNK(st) (S_ISLNK((st).st_mode))
#ifdef NO_UMASK
#define FILE_MODE 0644
#define DIR_MODE 0755
@@ -366,33 +365,6 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
int fd;
int mode; /* Open mode. */
- if (stat(name, &statbuf) < 0) {
- /* statbuf is undefined: if the caller depends on it,
- i.e. invoke_read_file(), fail the call immediately */
- if (pSize && flags == EFILE_MODE_READ)
- return check_error(-1, errInfo);
- } else if (!ISREG(statbuf)) {
- /*
- * For UNIX only, here is some ugly code to allow
- * /dev/null to be opened as a file.
- *
- * Assumption: The i-node number for /dev/null cannot be zero.
- */
- static ino_t dev_null_ino = 0;
-
- if (dev_null_ino == 0) {
- struct stat nullstatbuf;
-
- if (stat("/dev/null", &nullstatbuf) >= 0) {
- dev_null_ino = nullstatbuf.st_ino;
- }
- }
- if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
- }
-
switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) {
case EFILE_MODE_READ:
mode = O_RDONLY;
@@ -411,16 +383,13 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
return check_error(-1, errInfo);
}
-
if (flags & EFILE_MODE_APPEND) {
mode &= ~O_TRUNC;
mode |= O_APPEND;
}
-
if (flags & EFILE_MODE_EXCL) {
mode |= O_EXCL;
}
-
if (flags & EFILE_MODE_SYNC) {
#ifdef O_SYNC
mode |= O_SYNC;
@@ -430,15 +399,49 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
#endif
}
- fd = open(name, mode, FILE_MODE);
+#ifdef HAVE_FSTAT
+ while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
+ if (!check_error(fd, errInfo)) return 0;
+#endif
+
+ if (
+#ifdef HAVE_FSTAT
+ fstat(fd, &statbuf) < 0
+#else
+ stat(name, &statbuf) < 0
+#endif
+ ) {
+ /* statbuf is undefined: if the caller depends on it,
+ i.e. invoke_read_file(), fail the call immediately */
+ if (pSize && flags == EFILE_MODE_READ) {
+ check_error(-1, errInfo);
+#ifdef HAVE_FSTAT
+ efile_closefile(fd);
+#endif
+ return 0;
+ }
+ }
+ else if (! ISREG(statbuf)) {
+ struct stat nullstatbuf;
+ /*
+ * For UNIX only, here is some ugly code to allow
+ * /dev/null to be opened as a file.
+ */
+ if ( (stat("/dev/null", &nullstatbuf) < 0)
+ || (statbuf.st_ino != nullstatbuf.st_ino)
+ || (statbuf.st_dev != nullstatbuf.st_dev) ) {
+ errno = EISDIR;
+ return check_error(-1, errInfo);
+ }
+ }
- if (!check_error(fd, errInfo))
- return 0;
+#ifndef HAVE_FSTAT
+ while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
+ if (!check_error(fd, errInfo)) return 0;
+#endif
*pfd = fd;
- if (pSize) {
- *pSize = statbuf.st_size;
- }
+ if (pSize) *pSize = statbuf.st_size;
return 1;
}
@@ -460,7 +463,7 @@ efile_may_openfile(Efile_error* errInfo, char *name) {
void
efile_closefile(int fd)
{
- close(fd);
+ while((close(fd) < 0) && (errno == EINTR));
}
int
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index dcb6c35bfa..165f33eecd 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -992,7 +992,7 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
fe->native_address = native_address;
- if (erts_refc_dectest(&fe->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
erts_erase_fun_entry(fe);
BIF_RET(am_true);
}
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 9c03b3811c..a2165958a9 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -226,11 +226,6 @@ void hipe_handle_exception(Process *c_p)
ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */
- if (c_p->mbuf) {
- erts_printf("%s line %u: p==%p, p->mbuf==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf);
- /* erts_garbage_collect(c_p, 0, NULL, 0); */
- }
-
/*
* Check if we have an arglist for the top level call. If so, this
* is encoded in Value, so we have to dig out the real Value as well
@@ -259,11 +254,6 @@ void hipe_handle_exception(Process *c_p)
/* Synthesized to avoid having to generate code for it. */
c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)];
- if (c_p->mbuf) {
- /* erts_printf("%s line %u: p==%p, p->mbuf==%p, p->lastbif==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf, c_p->hipe.lastbif); */
- erts_garbage_collect(c_p, 0, NULL, 0);
- }
-
hipe_find_handler(c_p);
}
@@ -331,7 +321,7 @@ char *hipe_bs_allocate(int len)
Binary *bptr;
bptr = erts_bin_nrml_alloc(len);
- erts_smp_atomic_init_nob(&bptr->refc, 1);
+ erts_refc_init(&bptr->refc, 1);
return bptr->orig_bytes;
}
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 4b2edace0a..e135dbff99 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -119,9 +119,8 @@ erts_smp_atomic_t sys_misc_mem_sz;
static void smp_sig_notify(char c);
static int sig_notify_fds[2] = {-1, -1};
-#if !defined(ETHR_UNUSABLE_SIGUSRX) && defined(ERTS_THR_HAVE_SIG_FUNCS)
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
static int sig_suspend_fds[2] = {-1, -1};
-#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2
#endif
#endif
@@ -407,6 +406,7 @@ erts_sys_pre_init(void)
#ifdef ERTS_THR_HAVE_SIG_FUNCS
sigemptyset(&thr_create_sigmask);
sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */
+ sigaddset(&thr_create_sigmask, SIGTERM); /* block terminate signal */
sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */
#endif
@@ -655,6 +655,40 @@ static RETSIGTYPE request_break(int signum)
#endif
}
+static void stop_requested(void) {
+ Process* p = NULL;
+ Eterm msg, *hp;
+ ErtsProcLocks locks = 0;
+ ErlOffHeap *ohp;
+ Eterm id = erts_whereis_name_to_id(NULL, am_init);
+
+ if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) {
+ ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp);
+
+ /* init ! {stop,stop} */
+ msg = TUPLE2(hp, am_stop, am_stop);
+ erts_queue_message(p, locks, msgp, msg, am_system);
+
+ if (locks)
+ erts_smp_proc_unlock(p, locks);
+ erts_proc_dec_refc(p);
+ }
+}
+
+#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
+static RETSIGTYPE request_stop(void)
+#else
+static RETSIGTYPE request_stop(int signum)
+#endif
+{
+#ifdef ERTS_SMP
+ smp_sig_notify('S');
+#else
+ stop_requested();
+#endif
+}
+
+
static ERTS_INLINE void
sigusr1_exit(void)
{
@@ -751,6 +785,7 @@ static RETSIGTYPE do_quit(int signum)
/* Disable break */
void erts_set_ignore_break(void) {
sys_signal(SIGINT, SIG_IGN);
+ sys_signal(SIGTERM, SIG_IGN);
sys_signal(SIGQUIT, SIG_IGN);
sys_signal(SIGTSTP, SIG_IGN);
}
@@ -776,6 +811,7 @@ void erts_replace_intr(void) {
void init_break_handler(void)
{
sys_signal(SIGINT, request_break);
+ sys_signal(SIGTERM, request_stop);
#ifndef ETHR_UNUSABLE_SIGUSRX
sys_signal(SIGUSR1, user_signal1);
#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
@@ -1289,6 +1325,9 @@ signal_dispatcher_thread_func(void *unused)
switch (buf[i]) {
case 0: /* Emulator initialized */
break;
+ case 'S': /* SIGTERM */
+ stop_requested();
+ break;
case 'I': /* SIGINT */
break_requested();
break;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 2e48c475d5..453f819d1b 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -87,6 +87,7 @@ MODULES= \
op_SUITE \
port_SUITE \
port_bif_SUITE \
+ prim_eval_SUITE \
process_SUITE \
pseudoknot_SUITE \
receive_SUITE \
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index b8d89126fe..f70fb0e501 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -32,7 +32,8 @@
binary_to_atom/1,binary_to_existing_atom/1,
atom_to_binary/1,min_max/1, erlang_halt/1,
erl_crash_dump_bytes/1,
- is_builtin/1]).
+ is_builtin/1, error_stacktrace/1,
+ error_stacktrace_during_call_trace/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -44,8 +45,8 @@ all() ->
t_list_to_existing_atom, os_env, otp_7526,
display,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
- erl_crash_dump_bytes,
- min_max, erlang_halt, is_builtin].
+ erl_crash_dump_bytes, min_max, erlang_halt, is_builtin,
+ error_stacktrace, error_stacktrace_during_call_trace].
%% Uses erlang:display to test that erts_printf does not do deep recursion
display(Config) when is_list(Config) ->
@@ -727,6 +728,172 @@ is_builtin(_Config) ->
ok.
+error_stacktrace(Config) when is_list(Config) ->
+ error_stacktrace_test().
+
+error_stacktrace_during_call_trace(Config) when is_list(Config) ->
+ Tracer = spawn_link(fun () ->
+ receive after infinity -> ok end
+ end),
+ Mprog = [{'_',[],[{exception_trace}]}],
+ erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]),
+ 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]),
+ 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]),
+ erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]),
+ try
+ error_stacktrace_test()
+ after
+ erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]),
+ erlang:trace_pattern({erlang,error,2}, false, [local]),
+ erlang:trace_pattern({erlang,error,1}, false, [local]),
+ erlang:trace_pattern({?MODULE,'_','_'}, false, [local]),
+ unlink(Tracer),
+ exit(Tracer, kill),
+ Mon = erlang:monitor(process, Tracer),
+ receive
+ {'DOWN', Mon, process, Tracer, _} -> ok
+ end
+ end,
+ ok.
+
+
+error_stacktrace_test() ->
+ Types = [apply_const_last, apply_const, apply_last,
+ apply, double_apply_const_last, double_apply_const,
+ double_apply_last, double_apply, multi_apply_const_last,
+ multi_apply_const, multi_apply_last, multi_apply,
+ call_const_last, call_last, call_const, call],
+ lists:foreach(fun (Type) ->
+ {Pid, Mon} = spawn_monitor(
+ fun () ->
+ stk([a,b,c,d], Type, error_2)
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ {oops, Stack} = Reason,
+%% io:format("Type: ~p Stack: ~p~n",
+%% [Type, Stack]),
+ [{?MODULE, do_error_2, [Type], _},
+ {?MODULE, stk, 3, _},
+ {?MODULE, stk, 3, _}] = Stack
+ end
+ end,
+ Types),
+ lists:foreach(fun (Type) ->
+ {Pid, Mon} = spawn_monitor(
+ fun () ->
+ stk([a,b,c,d], Type, error_1)
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ {oops, Stack} = Reason,
+%% io:format("Type: ~p Stack: ~p~n",
+%% [Type, Stack]),
+ [{?MODULE, do_error_1, 1, _},
+ {?MODULE, stk, 3, _},
+ {?MODULE, stk, 3, _}] = Stack
+ end
+ end,
+ Types),
+ ok.
+
+stk([], Type, Func) ->
+ tail(Type, Func, jump),
+ ok;
+stk([_|L], Type, Func) ->
+ stk(L, Type, Func),
+ ok.
+
+tail(Type, Func, jump) ->
+ tail(Type, Func, do);
+tail(Type, error_1, do) ->
+ do_error_1(Type);
+tail(Type, error_2, do) ->
+ do_error_2(Type).
+
+do_error_2(apply_const_last) ->
+ erlang:apply(erlang, error, [oops, [apply_const_last]]);
+do_error_2(apply_const) ->
+ erlang:apply(erlang, error, [oops, [apply_const]]),
+ ok;
+do_error_2(apply_last) ->
+ erlang:apply(id(erlang), id(error), id([oops, [apply_last]]));
+do_error_2(apply) ->
+ erlang:apply(id(erlang), id(error), id([oops, [apply]])),
+ ok;
+do_error_2(double_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]);
+do_error_2(double_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]),
+ ok;
+do_error_2(double_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]);
+do_error_2(double_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]),
+ ok;
+do_error_2(multi_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]);
+do_error_2(multi_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]),
+ ok;
+do_error_2(multi_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]);
+do_error_2(multi_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]),
+ ok;
+do_error_2(call_const_last) ->
+ erlang:error(oops, [call_const_last]);
+do_error_2(call_last) ->
+ erlang:error(id(oops), id([call_last]));
+do_error_2(call_const) ->
+ erlang:error(oops, [call_const]),
+ ok;
+do_error_2(call) ->
+ erlang:error(id(oops), id([call])).
+
+
+do_error_1(apply_const_last) ->
+ erlang:apply(erlang, error, [oops]);
+do_error_1(apply_const) ->
+ erlang:apply(erlang, error, [oops]),
+ ok;
+do_error_1(apply_last) ->
+ erlang:apply(id(erlang), id(error), id([oops]));
+do_error_1(apply) ->
+ erlang:apply(id(erlang), id(error), id([oops])),
+ ok;
+do_error_1(double_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops]]);
+do_error_1(double_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops]]),
+ ok;
+do_error_1(double_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]);
+do_error_1(double_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]),
+ ok;
+do_error_1(multi_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]);
+do_error_1(multi_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]),
+ ok;
+do_error_1(multi_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]);
+do_error_1(multi_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]),
+ ok;
+do_error_1(call_const_last) ->
+ erlang:error(oops);
+do_error_1(call_last) ->
+ erlang:error(id(oops));
+do_error_1(call_const) ->
+ erlang:error(oops),
+ ok;
+do_error_1(call) ->
+ erlang:error(id(oops)).
+
+
+
%% Helpers
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index 6ba6301c7c..f7ff04430a 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -1090,8 +1090,7 @@ exception_nocatch() ->
{trace,t2,exception_from,{erlang,throw,1},
{error,{nocatch,Q2}}}],
exception_from, {error,{nocatch,Q2}}),
- expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]},
- {?MODULE,deep_4,1,
+ expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1,
Deep4LocThrow}]}}),
Q3 = {dump,[dump,{dump}]},
T3 =
@@ -1100,8 +1099,7 @@ exception_nocatch() ->
{trace,t3,exception_from,{erlang,error,1},
{error,Q3}}],
exception_from, {error,Q3}),
- expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]},
- {?MODULE,deep_4,1,Deep4LocError}]}}),
+ expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}),
T4 =
exception_nocatch(?LINE, '=', [17,4711], 5, [],
exception_from, {error,{badmatch,4711}}),
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 34515efa3d..3ee14f2d1c 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -66,9 +66,9 @@ versions(Config) when is_list(Config) ->
2 = versions:version(),
%% Kill processes, unload code.
- P1 ! P2 ! done,
_ = monitor(process, P1),
_ = monitor(process, P2),
+ P1 ! P2 ! done,
receive
{'DOWN',_,process,P1,normal} -> ok
end,
diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec
index 3219aeb823..b2d0de8835 100644
--- a/erts/emulator/test/emulator_smoke.spec
+++ b/erts/emulator/test/emulator_smoke.spec
@@ -1,3 +1,9 @@
-{suites,"../emulator_test",[smoke_test_SUITE,time_SUITE]}.
-{cases,"../emulator_test",crypto_SUITE,[t_md5]}.
-{cases,"../emulator_test",float_SUITE,[fpe,cmp_integer]}. \ No newline at end of file
+{define,'Dir',"../emulator_test"}.
+{suites,'Dir',[smoke_test_SUITE]}.
+{suites,'Dir',[time_SUITE]}.
+{skip_cases,'Dir',time_SUITE,
+ [univ_to_local,local_to_univ],"Depends on CET timezone"}.
+{skip_cases,'Dir',time_SUITE,
+ [consistency],"Not reliable in October and March"}.
+{cases,'Dir',crypto_SUITE,[t_md5]}.
+{cases,'Dir',float_SUITE,[fpe,cmp_integer]}.
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index e155e5f49f..54ee710363 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -317,6 +317,7 @@ guard_bifs(Config) when is_list(Config) ->
try_gbif('float/1', Big, float(id(Big))),
try_gbif('trunc/1', Float, 387924.0),
try_gbif('round/1', Float, 387925.0),
+ try_gbif('round/1', 6209607916799025.0, 6209607916799025),
try_gbif('length/1', [], 0),
try_gbif('length/1', [a], 1),
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index d1c9648017..bb85738454 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -293,6 +293,9 @@ t_round(Config) when is_list(Config) ->
4294967297 = round(id(4294967296.9)),
-4294967296 = -round(id(4294967296.1)),
-4294967297 = -round(id(4294967296.9)),
+
+ 6209607916799025 = round(id(6209607916799025.0)),
+ -6209607916799025 = round(id(-6209607916799025.0)),
ok.
t_trunc(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index d4e77d634a..23594aa8c4 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -2292,7 +2292,7 @@ maybe_to_list(List) ->
List.
format({Eol,List}) ->
- io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]);
+ io_lib:format("tuple<~w,~w>",[Eol, maybe_to_list(List)]);
format(List) when is_list(List) ->
case list_at_least(50, List) of
true ->
diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src
index fb7685c4b6..3a343e6d17 100644
--- a/erts/emulator/test/port_SUITE_data/Makefile.src
+++ b/erts/emulator/test/port_SUITE_data/Makefile.src
@@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@
echo_args@obj@: echo_args.c
$(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c
+dead_port@exe@: dead_port@obj@
+ $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@
+
+dead_port@obj@: dead_port.c
+ $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c
+
port_test.@EMULATOR@: port_test.erl
@erl_name@ -compile port_test
diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c
index cc3ebdf0f8..e199a0fc13 100644
--- a/erts/emulator/test/port_SUITE_data/port_test.c
+++ b/erts/emulator/test/port_SUITE_data/port_test.c
@@ -10,6 +10,7 @@
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
+#include <ctype.h>
#ifndef __WIN32__
#include <unistd.h>
@@ -33,7 +34,7 @@
exit(1); \
}
-#define MAIN(argc, argv) main(argc, argv)
+#define ASSERT(e) ((void) ((e) ? 1 : abort()))
extern int errno;
@@ -105,9 +106,7 @@ int err;
#endif
-MAIN(argc, argv)
-int argc;
-char *argv[];
+int main(int argc, char *argv[])
{
int ret, fd_count;
if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) {
@@ -377,9 +376,11 @@ write_reply(buf, size)
int size; /* Size of buffer to send. */
{
int n; /* Temporary to hold size. */
+ int rv;
if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */
- write(port_data->fd_to_erl, buf, size);
+ rv = write(port_data->fd_to_erl, buf, size);
+ ASSERT(rv == size);
} else {
/*
* Write chunks with delays in between.
@@ -387,7 +388,8 @@ write_reply(buf, size)
while (size > 0) {
n = size > port_data->slow_writes ? port_data->slow_writes : size;
- write(port_data->fd_to_erl, buf, n);
+ rv = write(port_data->fd_to_erl, buf, n);
+ ASSERT(rv == n);
size -= n;
buf += n;
if (size)
@@ -558,7 +560,7 @@ char* spec; /* Specification for reply. */
buf = (char *) malloc(total_size);
if (buf == NULL) {
fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n",
- port_data->progname, total_size);
+ port_data->progname, (int)total_size);
exit(1);
}
diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c
index b545523192..20ec33a594 100644
--- a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c
+++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c
@@ -2,23 +2,30 @@
#include "erl_driver.h"
#include <errno.h>
#include <string.h>
+#include <assert.h>
/* -------------------------------------------------------------------------
** Data types
**/
+struct my_thread {
+ struct my_thread* next;
+ ErlDrvTid tid;
+};
typedef struct _erl_drv_data {
ErlDrvPort erlang_port;
ErlDrvTermData caller;
+ struct my_thread* threads;
} EchoDrvData;
struct remote_send_term {
- char *buf;
- int len;
+ struct my_thread thread;
ErlDrvTermData port;
ErlDrvTermData caller;
+ int len;
+ char buf[1]; /* buf[len] */
};
#define ECHO_DRV_NOOP 0
@@ -86,7 +93,7 @@ static ErlDrvEntry echo_drv_entry = {
NULL
};
-static void send_term_thread(void *);
+static void* send_term_thread(void *);
/* -------------------------------------------------------------------------
** Entry functions
@@ -111,10 +118,22 @@ static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command)
EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData));
echo_drv_data_p->erlang_port = port;
echo_drv_data_p->caller = driver_caller(port);
+ echo_drv_data_p->threads = NULL;
return echo_drv_data_p;
}
-static void echo_drv_stop(EchoDrvData *data_p) {
+static void echo_drv_stop(EchoDrvData *data_p)
+{
+ struct my_thread* thr = data_p->threads;
+
+ while (thr) {
+ struct my_thread* next = thr->next;
+ void* exit_value;
+ int ret = erl_drv_thread_join(thr->tid, &exit_value);
+ assert(ret == 0 && exit_value == NULL);
+ driver_free(thr);
+ thr = next;
+ }
driver_free(data_p);
}
@@ -212,14 +231,14 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
}
case ECHO_DRV_REMOTE_SEND_TERM:
{
- ErlDrvTid tid;
- struct remote_send_term *t = malloc(sizeof(struct remote_send_term));
+ struct remote_send_term *t = driver_alloc(sizeof(struct remote_send_term) + len);
t->len = len-1;
- t->buf = malloc(len-1);
t->port = driver_mk_port(port);
t->caller = data_p->caller;
memcpy(t->buf, buf+1, t->len);
- erl_drv_thread_create("tmp_thread", &tid, send_term_thread, t, NULL);
+ erl_drv_thread_create("tmp_thread", &t->thread.tid, send_term_thread, t, NULL);
+ t->thread.next = data_p->threads;
+ data_p->threads = &t->thread;
break;
}
case ECHO_DRV_SAVE_CALLER:
@@ -262,7 +281,7 @@ static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data,
return len-command;
}
-static void send_term_thread(void *a)
+static void* send_term_thread(void *a)
{
struct remote_send_term *t = (struct remote_send_term*)a;
ErlDrvTermData term[] = {
@@ -273,5 +292,5 @@ static void send_term_thread(void *a)
ERL_DRV_TUPLE, 3};
erl_drv_send_term(t->port, t->caller,
term, sizeof(term) / sizeof(ErlDrvTermData));
- return;
+ return NULL;
}
diff --git a/erts/emulator/test/prim_eval_SUITE.erl b/erts/emulator/test/prim_eval_SUITE.erl
new file mode 100644
index 0000000000..3f4965f96d
--- /dev/null
+++ b/erts/emulator/test/prim_eval_SUITE.erl
@@ -0,0 +1,78 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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.
+%% 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(prim_eval_SUITE).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2,
+ init_per_group/2, end_per_group/2]).
+
+-export(['ERL-365'/1]).
+
+init_per_testcase(_Case, Config) ->
+ Config.
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+all() ->
+ ['ERL-365'].
+
+'ERL-365'(Config) when is_list(Config) ->
+ %% def_arg_reg[0] is used for storage of timeout instruction
+ %% when a 'receive after' is executed. When a process was
+ %% scheduled out inside prim_eval:'receive'/0 due to a function
+ %% call, def_arg_reg[0] was overwritten due to storage of live
+ %% registers.
+ P = spawn_link(fun () ->
+ prim_eval:'receive'(fun (_M) ->
+ erlang:bump_reductions((1 bsl 27)-1),
+ id(true),
+ nomatch
+ end,
+ 200)
+ end),
+ receive after 100 -> ok end,
+ P ! {wont, match},
+ receive after 200 -> ok end,
+ ok.
+
+
+
+id(X) ->
+ X.
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 0f999e0efe..0a6eb7ffac 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -437,11 +437,22 @@ t_process_info(Config) when is_list(Config) ->
verify_loc(Line2, Res2),
pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]),
+ verify_stacktrace_depth(),
+
Gleader = group_leader(),
{group_leader, Gleader} = process_info(self(), group_leader),
{'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')),
ok.
+verify_stacktrace_depth() ->
+ CS = current_stacktrace,
+ OldDepth = erlang:system_flag(backtrace_depth, 0),
+ {CS,[]} = erlang:process_info(self(), CS),
+ _ = erlang:system_flag(backtrace_depth, 8),
+ {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} =
+ erlang:process_info(self(), CS),
+ _ = erlang:system_flag(backtrace_depth, OldDepth).
+
pi_stacktrace(Expected0) ->
{Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)},
{current_stacktrace,Stack} = Res,
@@ -1611,6 +1622,7 @@ spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max ->
{Len, HAs};
spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) ->
Skip = 30,
+ wait_for_proc_slots(Skip+3),
HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
[{priority, low}]),
HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
@@ -1620,6 +1632,15 @@ spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) ->
spawn_drop(Skip),
spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]).
+wait_for_proc_slots(MinFreeSlots) ->
+ case erlang:system_info(process_limit) - erlang:system_info(process_count) of
+ FreeSlots when FreeSlots < MinFreeSlots ->
+ receive after 10 -> ok end,
+ wait_for_proc_slots(MinFreeSlots);
+ _FreeSlots ->
+ ok
+ end.
+
spawn_drop(N) when N =< 0 ->
ok;
spawn_drop(N) ->
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index d67b997d6d..bc353e384e 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -48,13 +48,10 @@
*
* HEART_BEATING
*
- * This program expects a heart beat messages. If it does not receive a
- * heart beat message from Erlang within heart_beat_timeout seconds, it
- * reboots the system. The variable heart_beat_timeout is exported (so
- * that it can be set from the shell in VxWorks, as is the variable
- * heart_beat_report_delay). When using Solaris, the system is rebooted
- * by executing the command stored in the environment variable
- * HEART_COMMAND.
+ * This program expects a heart beat message. If it does not receive a
+ * heart beat message from Erlang within heart_beat_timeout seconds, it
+ * reboots the system. The system is rebooted by executing the command
+ * stored in the environment variable HEART_COMMAND.
*
* BLOCKING DESCRIPTORS
*
@@ -149,27 +146,17 @@ struct msg {
/* Maybe interesting to change */
/* Times in seconds */
-#define HEART_BEAT_BOOT_DELAY 60 /* 1 minute */
#define SELECT_TIMEOUT 5 /* Every 5 seconds we reset the
watchdog timer */
/* heart_beat_timeout is the maximum gap in seconds between two
- consecutive heart beat messages from Erlang, and HEART_BEAT_BOOT_DELAY
- is the the extra delay that wd_keeper allows for, to give heart a
- chance to reboot in the "normal" way before the hardware watchdog
- enters the scene. heart_beat_report_delay is the time allowed for reporting
- before rebooting under VxWorks. */
+ consecutive heart beat messages from Erlang. */
int heart_beat_timeout = 60;
-int heart_beat_report_delay = 30;
-int heart_beat_boot_delay = HEART_BEAT_BOOT_DELAY;
/* All current platforms have a process identifier that
fits in an unsigned long and where 0 is an impossible or invalid value */
unsigned long heart_beat_kill_pid = 0;
-#define VW_WD_TIMEOUT (heart_beat_timeout+heart_beat_report_delay+heart_beat_boot_delay)
-#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay)
-
/* reasons for reboot */
#define R_TIMEOUT (1)
#define R_CLOSED (2)
@@ -297,7 +284,6 @@ free_env_val(char *value)
static void get_arguments(int argc, char** argv) {
int i = 1;
int h;
- int w;
unsigned long p;
while (i < argc) {
@@ -313,15 +299,6 @@ static void get_arguments(int argc, char** argv) {
i++;
}
break;
- case 'w':
- if (strcmp(argv[i], "-wt") == 0)
- if (sscanf(argv[i+1],"%i",&w) ==1)
- if ((w > 10) && (w <= 65535)) {
- heart_beat_boot_delay = w;
- fprintf(stderr,"heart_beat_boot_delay = %d\n",w);
- i++;
- }
- break;
case 'p':
if (strcmp(argv[i], "-pid") == 0)
if (sscanf(argv[i+1],"%lu",&p) ==1){
@@ -347,7 +324,7 @@ static void get_arguments(int argc, char** argv) {
}
i++;
}
- debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p);
+ debugf("arguments -ht %d -pid %lu\n",h,p);
}
int main(int argc, char **argv) {
@@ -674,11 +651,6 @@ void win_system(char *command)
*/
static void
do_terminate(int erlin_fd, int reason) {
- /*
- When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish
- (plus heart_beat_report_delay if under VxWorks), so we don't need
- to call wd_reset().
- */
int ret = 0, tmo=0;
char *tmo_env;
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index fa68bd26ee..f2babc48d2 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -1322,7 +1322,11 @@ define etp-stacktrace
set $etp_stacktrace_p = ($arg0)->stop
set $etp_stacktrace_end = ($arg0)->hend
printf "%% Stacktrace (%u): ", $etp_stacktrace_end-$etp_stacktrace_p
- etp ($arg0)->cp
+ if ($arg0)->cp == 0x0
+ printf "NULL\n"
+ else
+ etp ($arg0)->cp
+ end
while $etp_stacktrace_p < $etp_stacktrace_end
if ($etp_stacktrace_p[0] & 0x3) == 0x0
# Continuation pointer
@@ -1350,7 +1354,11 @@ define etp-stackdump
set $etp_stackdump_p = ($arg0)->stop
set $etp_stackdump_end = ($arg0)->hend
printf "%% Stackdump (%u): ", $etp_stackdump_end-$etp_stackdump_p
- etp ($arg0)->cp
+ if ($arg0)->cp == 0x0
+ printf "NULL\n"
+ else
+ etp ($arg0)->cp
+ end
while $etp_stackdump_p < $etp_stackdump_end
etp $etp_stackdump_p[0]
set $etp_stackdump_p++
diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c
index 420efd725f..3501fe335a 100644
--- a/erts/lib_src/common/ethr_aux.c
+++ b/erts/lib_src/common/ethr_aux.c
@@ -220,7 +220,7 @@ ethr_init_common__(ethr_init_data *id)
ethr_min_stack_size__ += ethr_pagesize__;
#endif
/* The system may think that we need more stack */
-#if defined(PTHREAD_STACK_MIN)
+#if defined(ETHR_HAVE_USABLE_PTHREAD_STACK_MIN)
if (ethr_min_stack_size__ < PTHREAD_STACK_MIN)
ethr_min_stack_size__ = PTHREAD_STACK_MIN;
#elif defined(_SC_THREAD_STACK_MIN)
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index a50a628a27..49fd62490e 100644
--- a/erts/preloaded/ebin/prim_eval.beam
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S
index e7f09a870c..c6623f8e03 100644
--- a/erts/preloaded/src/prim_eval.S
+++ b/erts/preloaded/src/prim_eval.S
@@ -26,7 +26,7 @@
{attributes, []}.
-{labels, 10}.
+{labels, 14}.
{function, 'receive', 2, 2}.
@@ -36,6 +36,9 @@
{allocate,2,2}.
{move,{x,1},{y,0}}.
{move,{x,0},{y,1}}.
+ %% Call arg_reg_alloc() in order to ensure
+ %% that def_arg_reg[0] isn't clobbered
+ {call,0,{f,7}}.
{label,3}.
{loop_rec,{f,5},{x,0}}.
{move,{y,1},{x,1}}.
@@ -53,19 +56,43 @@
{deallocate,2}.
return.
-
-{function, module_info, 0, 8}.
+{function, arg_reg_alloc, 0, 7}.
{label,6}.
- {func_info,{atom,prim_eval},{atom,module_info},0}.
+ {func_info,{atom,prim_eval},{atom,arg_reg_alloc},0}.
{label,7}.
+ {allocate,0,0}.
+ {move,{integer,134217727},{x,0}}.
+ {call_ext,1,{extfunc,erlang,bump_reductions,1}}.
+ {move,{atom,true},{x,3}}.
+ {move,{atom,true},{x,4}}.
+ {move,{atom,true},{x,2}}.
+ {move,{atom,true},{x,5}}.
+ {move,{atom,true},{x,1}}.
+ {move,{atom,true},{x,6}}.
+ {move,{atom,true},{x,0}}.
+ {call_last,7,{f,9},0}.
+
+
+{function, arg_reg_alloc, 7, 9}.
+ {label,8}.
+ {func_info,{atom,prim_eval},{atom,arg_reg_alloc},7}.
+ {label,9}.
+ {move,{atom,ok},{x,0}}.
+ return.
+
+
+{function, module_info, 0, 11}.
+ {label,10}.
+ {func_info,{atom,prim_eval},{atom,module_info},0}.
+ {label,11}.
{move,{atom,prim_eval},{x,0}}.
{call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
-{function, module_info, 1, 10}.
- {label,8}.
+{function, module_info, 1, 13}.
+ {label,12}.
{func_info,{atom,prim_eval},{atom,module_info},1}.
- {label,9}.
+ {label,13}.
{move,{x,0},{x,1}}.
{move,{atom,prim_eval},{x,0}}.
{call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl
index 2c7e8972f6..f96dca9563 100644
--- a/erts/test/install_SUITE.erl
+++ b/erts/test/install_SUITE.erl
@@ -18,7 +18,6 @@
%% %CopyrightEnd%
%%
-
%%%-------------------------------------------------------------------
%%% File : install_SUITE.erl
%%% Author : Rickard Green
@@ -63,12 +62,12 @@
erlang_bindir = "",
bindir_symlinks = ""}).
-need_symlink_cases() ->
+need_symlink_cases() ->
[bin_unreachable_absolute, bin_unreachable_relative,
bin_same_dir, bin_ok_symlink, bin_dirname_fail,
bin_no_use_dirname_fail].
-dont_need_symlink_cases() ->
+dont_need_symlink_cases() ->
[bin_default, bin_default_dirty, bin_outside_eprfx,
bin_outside_eprfx_dirty, bin_not_abs,
bin_unreasonable_path, 'bin white space',
@@ -78,10 +77,9 @@ suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 1}}].
-all() ->
+all() ->
dont_need_symlink_cases() ++ need_symlink_cases().
-
%%
%% The test cases
%%
@@ -533,21 +531,19 @@ bin_no_srcfile(Config) when is_list(Config) ->
ChkRes).
%%
-%%
%% Auxiliary functions
%%
-%%
expect(X, X) ->
- io:format("result: ~p~n", [X]),
+ io:format("result: ~tp~n", [X]),
io:format("-----------------------------------------------~n", []),
ok;
expect(X, Y) ->
- io:format("expected: ~p~n", [X]),
- io:format("got : ~p~n", [Y]),
+ io:format("expected: ~tp~n", [X]),
+ io:format("got : ~tp~n", [Y]),
io:format("-----------------------------------------------~n", []),
ct:fail({X,Y}).
-
+
init_per_suite(Config) ->
PD = proplists:get_value(priv_dir, Config),
SymLinks = case os:type() of
@@ -630,8 +626,8 @@ install_bin(Config, #inst{mkdirs = MkDirs,
true -> ok;
false -> {comment, "No symlink tests run, since symlinks not working"}
end.
-
-
+
+
install_bin2(Config, Inst, ChkRes) ->
install_bin3(Config, Inst#inst{symlinks = false,
ln_s = "ln"}, ChkRes),
@@ -662,8 +658,6 @@ install_bin2(Config, Inst, ChkRes) ->
false ->
ok
end.
-
-
install_bin3(Config,
#inst{cmd_prefix = CMD_PRFX,
@@ -690,20 +684,20 @@ install_bin3(Config,
++ "\" --exec-prefix \"" ++ EXEC_PREFIX
++ "\" --test-file \"" ++ ResFile ++ "\" erl erlc",
- io:format("CMD_PRFX = \"~s\"~n"
- "LN_S = \"~s\"~n"
- "BINDIR_SYMLINKS = \"~s\"~n"
- "exec_prefix = \"~s\"~n"
- "bindir = \"~s\"~n"
- "erlang_bindir = \"~s\"~n"
- "EXTRA_PREFIX = \"~s\"~n"
- "DESTDIR = \"~s\"~n",
+ io:format("CMD_PRFX = \"~ts\"~n"
+ "LN_S = \"~ts\"~n"
+ "BINDIR_SYMLINKS = \"~ts\"~n"
+ "exec_prefix = \"~ts\"~n"
+ "bindir = \"~ts\"~n"
+ "erlang_bindir = \"~ts\"~n"
+ "EXTRA_PREFIX = \"~ts\"~n"
+ "DESTDIR = \"~ts\"~n",
[CMD_PRFX, LN_S, BINDIR_SYMLINKS, EXEC_PREFIX, BINDIR,
ERLANG_BINDIR, EXTRA_PREFIX, DESTDIR]),
- io:format("$ ~s~n", [Cmd]),
+ io:format("$ ~ts~n", [Cmd]),
CmdOutput = os:cmd(Cmd),
- io:format("~s~n", [CmdOutput]),
+ io:format("~ts~n", [CmdOutput]),
ChkRes(case file:consult(ResFile) of
{ok, [Res]} -> Res;
Err -> exit({result, Err})
diff --git a/erts/test/system_smoke.spec b/erts/test/system_smoke.spec
index 933d1ba22d..99092c1dab 100644
--- a/erts/test/system_smoke.spec
+++ b/erts/test/system_smoke.spec
@@ -1,3 +1,8 @@
{suites,"../system_test",[ethread_SUITE]}.
-{cases,"../system_test",otp_SUITE,[undefined_functions]}.
+{cases,"../system_test",otp_SUITE,
+ [undefined_functions,
+ deprecated_not_in_obsolete,
+ obsolete_but_not_deprecated,
+ call_to_size_1,
+ call_to_now_0]}.
{skip_cases,"../system_test",ethread_SUITE,[max_threads],"Skip"}.
diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl
index 174c028ac7..f93da8955f 100644
--- a/erts/test/upgrade_SUITE.erl
+++ b/erts/test/upgrade_SUITE.erl
@@ -54,6 +54,10 @@ init_per_suite(Config) ->
Config
end.
+end_per_suite(_Config) ->
+ %% This function is required since init_per_suite/1 exists.
+ ok.
+
init_per_testcase(Case,Config) ->
PrivDir = filename:join([proplists:get_value(data_dir,Config),priv_dir,Case]),
CreateDir = filename:join([PrivDir,create]),
diff --git a/erts/vsn.mk b/erts/vsn.mk
index af0be85062..4578d4e0b1 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 8.2
+VSN = 8.3
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index e495f587a3..152ece5d25 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -53,7 +53,8 @@ XML_REF3_FILES = ct.xml \
ct_slave.xml \
ct_property_test.xml \
ct_netconfc.xml \
- ct_hooks.xml
+ ct_hooks.xml \
+ ct_testspec.xml
XML_REF6_FILES = common_test_app.xml
XML_PART_FILES = part.xml
diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml
index 48ffe653e4..d407a0a53f 100644
--- a/lib/common_test/doc/src/common_test_app.xml
+++ b/lib/common_test/doc/src/common_test_app.xml
@@ -224,7 +224,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:end_per_suite-1"><c>end_per_suite/1</c></seealso>
+ must also be defined.</p>
<p>This configuration function is called as the first function in the
suite. It typically contains initializations that are common for
@@ -256,7 +258,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:init_per_suite-1"><c>init_per_suite/1</c></seealso>
+ must also be defined.</p>
<p>This function is called as the last test case in the
suite. It is meant to be used for cleaning up after
@@ -360,7 +364,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:end_per_group-2"><c>end_per_group/2</c></seealso>
+ must also be defined.</p>
<p>This configuration function is called before execution of a
test case group. It typically contains initializations that are
@@ -396,7 +402,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:init_per_group-2"><c>init_per_group/2</c></seealso>
+ must also be defined.</p>
<p>This function is called after the execution of a test case group
is finished. It is meant to be used for cleaning up after
@@ -427,7 +435,10 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined,
+ then <seealso marker="#Module:end_per_testcase-2">
+ <c>end_per_testcase/2</c></seealso> must also be
+ defined.</p>
<p>This function is called before each test case. Argument
<c>TestCase</c> is the test case name, and
@@ -454,7 +465,10 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined,
+ then <seealso marker="#Module:init_per_testcase-2">
+ <c>init_per_testcase/2</c></seealso> must also be
+ defined.</p>
<p>This function is called after each test case, and can be used
to clean up after
diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml
index c2cf29c530..a085f30262 100644
--- a/lib/common_test/doc/src/ct_hooks.xml
+++ b/lib/common_test/doc/src/ct_hooks.xml
@@ -208,9 +208,10 @@
</func>
<func>
- <name>Module:pre_init_per_group(GroupName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_init_per_group(SuiteName, GroupName, InitData, CTHState) -&gt; Result</name>
<fsummary>Called before init_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>InitData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -231,13 +232,19 @@
but for function
<seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:pre_init_per_group/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_init_per_group(GroupName,
+ InitData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_init_per_group(GroupName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_init_per_group(SuiteName, GroupName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after init_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -258,13 +265,19 @@
but for function
<seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_init_per_group/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_init_per_group(GroupName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_init_per_testcase(TestcaseName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_init_per_testcase(SuiteName, TestcaseName, InitData, CTHState) -&gt; Result</name>
<fsummary>Called before init_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>InitData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -286,6 +299,11 @@
<seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso>
instead.</p>
+ <p>If <c>Module:pre_init_per_testcase/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_init_per_testcase(TestcaseName,
+ InitData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
+
<p>CTHs cannot be added here right now. That feature may be added in
a later release, but it would right now break backwards
compatibility.</p>
@@ -293,9 +311,10 @@
</func>
<func>
- <name>Module:post_init_per_testcase(TestcaseName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_init_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after init_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -316,15 +335,21 @@
but for function
<seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_init_per_testcase/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_init_per_testcase(TestcaseName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_end_per_testcase(TestcaseName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_end_per_testcase(SuiteName, TestcaseName, EndData, CTHState) -&gt; Result</name>
<fsummary>Called before end_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
- <v>InitData = Config</v>
+ <v>EndData = Config</v>
<v>Config = NewConfig = [{Key,Value}]</v>
<v>CTHState = NewCTHState = term()</v>
<v>Result = {NewConfig, NewCTHState}</v>
@@ -345,14 +370,20 @@
<p>This function can not change the result of the test case by returning skip or fail
tuples, but it may insert items in <c>Config</c> that can be read in
- <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/4</c>.</p>
+ <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/5</c>.</p>
+
+ <p>If <c>Module:pre_end_per_testcase/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_end_per_testcase(TestcaseName,
+ EndData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_end_per_testcase(TestcaseName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_end_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after end_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -373,13 +404,19 @@
but for function
<seealso marker="common_test#Module:end_per_testcase-2"><c>end_per_testcase</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_end_per_testcase/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_end_per_testcase(TestcaseName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_end_per_group(GroupName, EndData, CTHState) -&gt; Result</name>
+ <name>Module:pre_end_per_group(SuiteName, GroupName, EndData, CTHState) -&gt; Result</name>
<fsummary>Called before end_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>EndData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -400,13 +437,19 @@
but for function
<seealso marker="common_test#Module:end_per_group-2"><c>end_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:pre_end_per_group/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_end_per_group(GroupName,
+ EndData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_end_per_group(GroupName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_end_per_group(SuiteName, GroupName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after end_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -427,6 +470,11 @@
but for function
<seealso marker="common_test#Module:end_per_group-2">end_per_group</seealso>
instead.</p>
+
+ <p>If <c>Module:post_end_per_group/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_end_per_group(GroupName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
@@ -485,9 +533,10 @@
</func>
<func>
- <name>Module:on_tc_fail(TestName, Reason, CTHState) -&gt; NewCTHState</name>
+ <name>Module:on_tc_fail(SuiteName, TestName, Reason, CTHState) -&gt; NewCTHState</name>
<fsummary>Called after the CTH scope ends.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v>
<v>FuncName = atom()</v>
<v>GroupName = atom()</v>
@@ -505,7 +554,7 @@
<item><p>If <c>init_per_suite</c> fails, this function is called after
<seealso marker="#Module:post_init_per_suite-4"><c>post_init_per_suite</c></seealso>.</p></item>
<item><p>If a test case fails, this funcion is called after
- <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item>
+ <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item>
</list>
<p>If the failed test case belongs to a test case group, the first
@@ -519,13 +568,19 @@
For details, see section
<seealso marker="event_handler_chapter#events">Event Handling</seealso>
in the User's Guide.</p>
+
+ <p>If <c>Module:on_tc_fail/4</c> is not exported, common_test
+ will attempt to call <c>Module:on_tc_fail(TestName, Reason,
+ CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:on_tc_skip(TestName, Reason, CTHState) -&gt; NewCTHState</name>
+ <name>Module:on_tc_skip(SuiteName, TestName, Reason, CTHState) -&gt; NewCTHState</name>
<fsummary>Called after the CTH scope ends.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v>
<v>FuncName = atom()</v>
<v>GroupName = atom()</v>
@@ -542,9 +597,9 @@
<list type="bulleted">
<item><p>If <c>init_per_group</c> is skipped, this function is
called after
- <seealso marker="#Module:post_init_per_group-4"><c>post_init_per_group</c></seealso>.</p></item>
+ <seealso marker="#Module:post_init_per_group-5"><c>post_init_per_group</c></seealso>.</p></item>
<item><p>If a test case is skipped, this function is called after
- <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item>
+ <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item>
</list>
<p>If the skipped test case belongs to a test case group, the first
@@ -559,6 +614,11 @@
For details, see section
<seealso marker="event_handler_chapter#events">Event Handling</seealso>
in the User's Guide.</p>
+
+ <p>If <c>Module:on_tc_skip/4</c> is not exported, common_test
+ will attempt to call <c>Module:on_tc_skip(TestName, Reason,
+ CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml
index 0e4c35e11f..bfad96e489 100644
--- a/lib/common_test/doc/src/ct_hooks_chapter.xml
+++ b/lib/common_test/doc/src/ct_hooks_chapter.xml
@@ -38,7 +38,7 @@
extensions of the default behavior of <c>Common Test</c> using hooks
before and after all test suite calls. CTHs allow advanced <c>Common Test</c>
users to abstract out behavior that is common to multiple test suites
- without littering all test suites with library calls. this can be used
+ without littering all test suites with library calls. This can be used
for logging, starting, and monitoring external systems,
building C files needed by the tests, and so on.</p>
@@ -175,10 +175,10 @@
<row>
<cell><seealso marker="common_test#Module:init_per_group-2">
init_per_group/2</seealso></cell>
- <cell><seealso marker="ct_hooks#Module:post_init_per_group-4">
- post_init_per_group/4</seealso> is called</cell>
- <cell><seealso marker="ct_hooks#Module:post_end_per_suite-4">
- post_end_per_group/4</seealso> has been called for that group</cell>
+ <cell><seealso marker="ct_hooks#Module:post_init_per_group-5">
+ post_init_per_group/5</seealso> is called</cell>
+ <cell><seealso marker="ct_hooks#Module:post_end_per_group-5">
+ post_end_per_group/5</seealso> has been called for that group</cell>
</row>
<tcaption>Scope of a CTH</tcaption>
</table>
@@ -245,16 +245,18 @@
</list>
<p>
- This is done in the CTH functions called pre_&lt;name of function&gt;.
- These functions take the same three arguments, <c>Name</c>,
+ This is done in the CTH functions called <c>pre_&lt;name of function&gt;</c>.
+ These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable),
<c>Config</c>, and <c>CTHState</c>. The return value of the CTH function
is always a combination of a result for the suite/group/test and an
updated <c>CTHState</c>.</p>
<p>To let the test suite continue on executing, return the configuration
- list that you want the test to use as the result. To skip or
- fail the test, return a tuple with <c>skip</c> or <c>fail</c>, and a reason
- as the result.</p>
+ list that you want the test to use as the result.</p>
+
+ <p>All pre hooks, except <c>pre_end_per_testcase/4</c>, can
+ skip or fail the test by returning a tuple with <c>skip</c> or
+ <c>fail</c>, and a reason as the result.</p>
<p><em>Example:</em></p>
<code>
@@ -290,7 +292,7 @@
<p>
This is done in the CTH functions called <c>post_&lt;name of function&gt;</c>.
- These functions take the same four arguments, <c>Name</c>,
+ These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable),
<c>Config</c>, <c>Return</c>, and <c>CTHState</c>. <c>Config</c> in this
case is the same <c>Config</c> as the testcase is called with.
<c>Return</c> is the value returned by the testcase. If the testcase
@@ -308,7 +310,7 @@
<p><em>Example:</em></p>
<code>
- post_end_per_testcase(_TC, Config, {'EXIT',{_,_}}, CTHState) -&gt;
+ post_end_per_testcase(_Suite, _TC, Config, {'EXIT',{_,_}}, CTHState) -&gt;
case db:check_consistency() of
true ->
%% DB is good, pass the test.
@@ -317,7 +319,7 @@
%% DB is not good, mark as skipped instead of failing
{{skip, "DB is inconsisten!"}, CTHState}
end;
- post_end_per_testcase(_TC, Config, Return, CTHState) -&gt;
+ post_end_per_testcase(_Suite, _TC, Config, Return, CTHState) -&gt;
%% Do nothing if tc does not crash.
{Return, CTHState}.</code>
@@ -331,8 +333,8 @@
<title>Skip and Fail Hooks</title>
<p>
After any post hook has been executed for all installed CTHs,
- <seealso marker="ct_hooks#Module:on_tc_fail-3">on_tc_fail</seealso>
- or <seealso marker="ct_hooks#Module:on_tc_skip-3">on_tc_skip</seealso>
+ <seealso marker="ct_hooks#Module:on_tc_fail-4">on_tc_fail</seealso>
+ or <seealso marker="ct_hooks#Module:on_tc_skip-4">on_tc_skip</seealso>
is called if the testcase failed or was skipped, respectively.
You cannot affect the outcome of the tests any further at this point.
</p>
@@ -389,18 +391,18 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
- -export([pre_init_per_group/3]).
- -export([post_init_per_group/4]).
- -export([pre_end_per_group/3]).
- -export([post_end_per_group/4]).
+ -export([pre_init_per_group/4]).
+ -export([post_init_per_group/5]).
+ -export([pre_end_per_group/4]).
+ -export([post_end_per_group/5]).
- -export([pre_init_per_testcase/3]).
- -export([post_init_per_testcase/4]).
- -export([pre_end_per_testcase/3]).
- -export([post_end_per_testcase/4]).
+ -export([pre_init_per_testcase/4]).
+ -export([post_init_per_testcase/5]).
+ -export([pre_end_per_testcase/4]).
+ -export([post_end_per_testcase/5]).
- -export([on_tc_fail/3]).
- -export([on_tc_skip/3]).
+ -export([on_tc_fail/4]).
+ -export([on_tc_skip/4]).
-export([terminate/1]).
@@ -435,46 +437,46 @@
total = State#state.total + State#state.suite_total } }.
%% @doc Called before each init_per_group.
- pre_init_per_group(Group,Config,State) ->
+ pre_init_per_group(Suite,Group,Config,State) ->
{Config, State}.
%% @doc Called after each init_per_group.
- post_init_per_group(Group,Config,Return,State) ->
+ post_init_per_group(Suite,Group,Config,Return,State) ->
{Return, State}.
%% @doc Called before each end_per_group.
- pre_end_per_group(Group,Config,State) ->
+ pre_end_per_group(Suite,Group,Config,State) ->
{Config, State}.
%% @doc Called after each end_per_group.
- post_end_per_group(Group,Config,Return,State) ->
+ post_end_per_group(Suite,Group,Config,Return,State) ->
{Return, State}.
%% @doc Called before each init_per_testcase.
- pre_init_per_testcase(TC,Config,State) ->
+ pre_init_per_testcase(Suite,TC,Config,State) ->
{Config, State#state{ ts = now(), total = State#state.suite_total + 1 } }.
%% Called after each init_per_testcase (immediately before the test case).
- post_init_per_testcase(TC,Config,Return,State) ->
+ post_init_per_testcase(Suite,TC,Config,Return,State) ->
{Return, State}
%% @doc Called before each end_per_testcase (immediately after the test case).
- pre_end_per_testcase(TC,Config,State) ->
+ pre_end_per_testcase(Suite,TC,Config,State) ->
{Config, State}.
%% @doc Called after each end_per_testcase.
- post_end_per_testcase(TC,Config,Return,State) ->
- TCInfo = {testcase, TC, Return, timer:now_diff(now(), State#state.ts)},
+ post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ TCInfo = {testcase, Suite, TC, Return, timer:now_diff(now(), State#state.ts)},
{Return, State#state{ ts = undefined, tcs = [TCInfo | State#state.tcs] } }.
%% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group,
%% post_end_per_group and post_end_per_testcase if the suite, group or test case failed.
- on_tc_fail(TC, Reason, State) ->
+ on_tc_fail(Suite, TC, Reason, State) ->
State.
%% @doc Called when a test case is skipped by either user action
%% or due to an init function failing.
- on_tc_skip(TC, Reason, State) ->
+ on_tc_skip(Suite, TC, Reason, State) ->
State.
%% @doc Called when the scope of the CTH is done
diff --git a/lib/common_test/doc/src/ct_testspec.xml b/lib/common_test/doc/src/ct_testspec.xml
new file mode 100644
index 0000000000..36893f66cf
--- /dev/null
+++ b/lib/common_test/doc/src/ct_testspec.xml
@@ -0,0 +1,84 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2016</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ 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.
+
+ </legalnotice>
+
+ <title>ct_testspec</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>ct_testspec.xml</file>
+ </header>
+ <module>ct_testspec</module>
+ <modulesummary>Parsing of test specifications for Common Test.
+ </modulesummary>
+
+<description>
+
+ <p>Parsing of test specifications for <c>Common Test</c>.</p>
+
+ <p>This module exports help functions for parsing of test specifications.</p>
+
+</description>
+
+ <funcs>
+ <func>
+ <name>get_tests(SpecsIn) -&gt; {ok, [{Specs,Tests}]} | {error, Reason}</name>
+ <fsummary>Parse the given test specification files and return the tests to run and skip.</fsummary>
+ <type>
+ <v>SpecsIn = [string()] | [[string()]]</v>
+ <v>Specs = [string()]</v>
+ <v>Test = [{Node,Run,Skip}]</v>
+ <v>Node = atom()</v>
+ <v>Run = {Dir,Suites,Cases}</v>
+ <v>Skip = {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}</v>
+ <v>Dir = string()</v>
+ <v>Suites = atom | [atom()] | all</v>
+ <v>Cases = atom | [atom()] | all</v>
+ <v>Comment = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc><marker id="add_nodes-1"/>
+ <p>Parse the given test specification files and return the
+ tests to run and skip.</p>
+
+ <p>If <c>SpecsIn=[Spec1,Spec2,...]</c>, separate tests will be
+ created per specification. If
+ <c>SpecsIn=[[Spec1,Spec2,...]]</c>, all specifications will be
+ merge into one test.</p>
+
+ <p>For each test, a <c>{Specs,Tests}</c> element is returned,
+ where <c>Specs</c> is a list of all included test
+ specifications, and <c>Tests</c> specifies actual tests to
+ run/skip per node.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml
index d1567e2d3c..1ac20db5c2 100644
--- a/lib/common_test/doc/src/ref_man.xml
+++ b/lib/common_test/doc/src/ref_man.xml
@@ -47,6 +47,7 @@
<xi:include href="ct_slave.xml"/>
<xi:include href="ct_hooks.xml"/>
<xi:include href="ct_property_test.xml"/>
+ <xi:include href="ct_testspec.xml"/>
</application>
diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml
index f70bdb16c5..6a0d87bcaf 100644
--- a/lib/common_test/doc/src/write_test_chapter.xml
+++ b/lib/common_test/doc/src/write_test_chapter.xml
@@ -566,7 +566,7 @@
for the test cases in the group. After execution of the group is finished, function
<seealso marker="common_test#Module:end_per_group-2"><c>end_per_group(GroupName, Config)</c></seealso>
is called. This function is meant to be used for cleaning up after
- <c>init_per_group/2</c>.</p>
+ <c>init_per_group/2</c>. If the init function is defined, so must the end function be.</p>
<p>Whenever a group is executed, if <c>init_per_group</c> and
<c>end_per_group</c> do not exist in the suite, <c>Common Test</c> calls
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/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 291a4d716c..43f1c9de0f 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -52,6 +52,10 @@
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a new test case is started.
+init_tc(_,{end_per_testcase_not_run,_},[Config]) ->
+ %% Testcase is completed (skipped or failed), but end_per_testcase
+ %% is not run - don't call pre-hook.
+ {ok,[Config]};
init_tc(Mod,EPTC={end_per_testcase,_},[Config]) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Config),
@@ -62,7 +66,7 @@ init_tc(Mod,EPTC={end_per_testcase,_},[Config]) ->
Other
end;
-init_tc(Mod,Func0,Args) ->
+init_tc(Mod,Func0,Args) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Args),
{Func,HookFunc} = case Func0 of
@@ -84,12 +88,15 @@ init_tc(Mod,Func0,Args) ->
andalso Func=/=end_per_group
andalso ct_util:get_testdata(skip_rest) of
true ->
+ initialize(false,Mod,Func,Args),
{auto_skip,"Repeated test stopped by force_stop option"};
_ ->
case ct_util:get_testdata(curr_tc) of
{Suite,{suite0_failed,{require,Reason}}} ->
+ initialize(false,Mod,Func,Args),
{auto_skip,{require_failed_in_suite0,Reason}};
{Suite,{suite0_failed,_}=Failure} ->
+ initialize(false,Mod,Func,Args),
{fail,Failure};
_ ->
ct_util:update_testdata(curr_tc,
@@ -118,16 +125,14 @@ init_tc(Mod,Func0,Args) ->
end,
init_tc1(Mod,Suite,Func,HookFunc,Args);
{failed,Seq,BadFunc} ->
- {auto_skip,{sequence_failed,Seq,BadFunc}}
+ initialize(false,Mod,Func,Args),
+ {auto_skip,{sequence_failed,Seq,BadFunc}}
end
end
end.
init_tc1(?MODULE,_,error_in_suite,_,[Config0]) when is_list(Config0) ->
- ct_logs:init_tc(false),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={?MODULE,error_in_suite}}),
+ initialize(false,?MODULE,error_in_suite),
_ = ct_suite_init(?MODULE,error_in_suite,[],Config0),
case ?val(error,Config0) of
undefined ->
@@ -177,27 +182,21 @@ init_tc1(Mod,Suite,Func,HookFunc,[Config0]) when is_list(Config0) ->
ct_config:delete_default_config(testcase),
HookFunc
end,
- Initialize = fun() ->
- ct_logs:init_tc(false),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={Mod,FuncSpec}})
- end,
case add_defaults(Mod,Func,AllGroups) of
Error = {suite0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
ct_util:set_testdata({curr_tc,{Suite,Error}}),
{error,Error};
Error = {group0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{auto_skip,Error};
Error = {testcase0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{auto_skip,Error};
{SuiteInfo,MergeResult} ->
case MergeResult of
{error,Reason} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{fail,Reason};
_ ->
init_tc2(Mod,Suite,Func,HookFunc1,
@@ -236,11 +235,8 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) ->
Conns ->
ct_util:silence_connections(Conns)
end,
- ct_logs:init_tc(Func == init_per_suite),
FuncSpec = group_or_func(Func,Config),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={Mod,FuncSpec}}),
+ initialize((Func==init_per_suite),Mod,FuncSpec),
case catch configure(MergedInfo,MergedInfo,SuiteInfo,
FuncSpec,[],Config) of
@@ -268,6 +264,18 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) ->
end
end.
+initialize(RefreshLogs,Mod,Func,[Config]) when is_list(Config) ->
+ initialize(RefreshLogs,Mod,group_or_func(Func,Config));
+initialize(RefreshLogs,Mod,Func,_) ->
+ initialize(RefreshLogs,Mod,Func).
+
+initialize(RefreshLogs,Mod,FuncSpec) ->
+ ct_logs:init_tc(RefreshLogs),
+ ct_event:notify(#event{name=tc_start,
+ node=node(),
+ data={Mod,FuncSpec}}).
+
+
ct_suite_init(Suite,HookFunc,PostInitHook,Config) when is_list(Config) ->
case ct_hooks:init_tc(Suite,HookFunc,Config) of
NewConfig when is_list(NewConfig) ->
@@ -675,22 +683,35 @@ end_tc(Mod,Func,{Result,[Args]}, Return) ->
end_tc(Mod,Func,self(),Result,Args,Return).
end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) ->
- %% in case Mod == ct_framework, lookup the suite name
- Suite = get_suite_name(Mod, Args),
- case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of
- '$ct_no_change' ->
- ok;
- HookResult ->
- HookResult
+ case end_hook_func(IPTC,Return,IPTC) of
+ undefined -> ok;
+ _ ->
+ %% in case Mod == ct_framework, lookup the suite name
+ Suite = get_suite_name(Mod, Args),
+ case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of
+ '$ct_no_change' ->
+ ok;
+ HookResult ->
+ HookResult
+ end
end;
end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Args),
- {EPTC,Func} = case Func0 of
- {end_per_testcase,F} -> {true,F};
- _ -> {false,Func0}
- end,
+ {Func,FuncSpec,HookFunc} =
+ case Func0 of
+ {end_per_testcase_not_run,F} ->
+ %% Testcase is completed (skipped or failed), but
+ %% end_per_testcase is not run - don't call post-hook.
+ {F,F,undefined};
+ {end_per_testcase,F} ->
+ {F,F,Func0};
+ _ ->
+ FS = group_or_func(Func0,Args),
+ HF = end_hook_func(Func0,Return,FS),
+ {Func0,FS,HF}
+ end,
test_server:timetrap_cancel(),
@@ -717,20 +738,18 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
end,
ct_util:delete_suite_data(last_saved_config),
- {FuncSpec,HookFunc} =
- if not EPTC ->
- FS = group_or_func(Func,Args),
- {FS,FS};
- true ->
- {Func,Func0}
- end,
{Result1,FinalNotify} =
- case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of
- '$ct_no_change' ->
- {ok,Result};
- HookResult ->
- {HookResult,HookResult}
- end,
+ case HookFunc of
+ undefined ->
+ {ok,Result};
+ _ ->
+ case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of
+ '$ct_no_change' ->
+ {ok,Result};
+ HookResult ->
+ {HookResult,HookResult}
+ end
+ end,
FinalResult =
case get('$test_server_framework_test') of
undefined ->
@@ -821,6 +840,34 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
end,
FinalResult.
+%% This is to make sure that no post_init_per_* is ever called if the
+%% corresponding pre_init_per_* was not called.
+%% The skip or fail reasons are those that can be returned from
+%% init_tc above in situations where we never came to call
+%% ct_hooks:init_tc/3, e.g. if suite/0 fails, then we never call
+%% ct_hooks:init_tc for init_per_suite, and thus we must not call
+%% ct_hooks:end_tc for init_per_suite either.
+end_hook_func({init_per_testcase,_},{auto_skip,{sequence_failed,_,_}},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{auto_skip,"Repeated test stopped by force_stop option"},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{fail,{config_name_already_in_use,_}},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{auto_skip,{InfoFuncError,_}},_)
+ when InfoFuncError==testcase0_failed;
+ InfoFuncError==require_failed ->
+ undefined;
+end_hook_func(init_per_group,{auto_skip,{InfoFuncError,_}},_)
+ when InfoFuncError==group0_failed;
+ InfoFuncError==require_failed ->
+ undefined;
+end_hook_func(init_per_suite,{auto_skip,{require_failed_in_suite0,_}},_) ->
+ undefined;
+end_hook_func(init_per_suite,{auto_skip,{failed,{error,{suite0_failed,_}}}},_) ->
+ undefined;
+end_hook_func(_,_,Default) ->
+ Default.
+
%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} |
%% {testcase_aborted,Reason} | testcase_aborted_or_killed |
%% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} |
@@ -1339,25 +1386,25 @@ report(What,Data) ->
ok;
tc_done ->
{Suite,{Func,GrName},Result} = Data,
- Data1 = if GrName == undefined -> {Suite,Func,Result};
- true -> Data
- end,
+ FuncSpec = if GrName == undefined -> Func;
+ true -> {Func,GrName}
+ end,
%% Register the group leader for the process calling the report
%% function, making it possible for a hook function to print
%% in the test case log file
ReportingPid = self(),
ct_logs:register_groupleader(ReportingPid, group_leader()),
case Result of
- {failed, _} ->
- ct_hooks:on_tc_fail(What, Data1);
- {skipped,{failed,{_,init_per_testcase,_}}} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
- {skipped,{require_failed,_}} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
- {skipped,_} ->
- ct_hooks:on_tc_skip(tc_user_skip, Data1);
- {auto_skipped,_} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
+ {failed, Reason} ->
+ ct_hooks:on_tc_fail(What, {Suite,FuncSpec,Reason});
+ {skipped,{failed,{_,init_per_testcase,_}}=Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
+ {skipped,{require_failed,_}=Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
+ {skipped,Reason} ->
+ ct_hooks:on_tc_skip(tc_user_skip, {Suite,FuncSpec,Reason});
+ {auto_skipped,Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
_Else ->
ok
end,
diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl
index 1375e7dcc7..1c9faf6a70 100644
--- a/lib/common_test/src/ct_groups.erl
+++ b/lib/common_test/src/ct_groups.erl
@@ -442,17 +442,21 @@ make_conf(Mod, Name, Props, TestSpec) ->
ok
end,
{InitConf,EndConf,ExtraProps} =
- case erlang:function_exported(Mod,init_per_group,2) of
- true ->
- {{Mod,init_per_group},{Mod,end_per_group},[]};
- false ->
+ case {erlang:function_exported(Mod,init_per_group,2),
+ erlang:function_exported(Mod,end_per_group,2)} of
+ {false,false} ->
ct_logs:log("TEST INFO", "init_per_group/2 and "
"end_per_group/2 missing for group "
"~w in ~w, using default.",
[Name,Mod]),
{{ct_framework,init_per_group},
{ct_framework,end_per_group},
- [{suite,Mod}]}
+ [{suite,Mod}]};
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ {{Mod,init_per_group},{Mod,end_per_group},[]}
end,
{conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}.
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
index c9a4abb5ee..60d1ea2b1c 100644
--- a/lib/common_test/src/ct_hooks.erl
+++ b/lib/common_test/src/ct_hooks.erl
@@ -92,15 +92,17 @@ init_tc(Mod, end_per_suite, Config) ->
call(fun call_generic/3, Config, [pre_end_per_suite, Mod]);
init_tc(Mod, {init_per_group, GroupName, Properties}, Config) ->
maybe_start_locker(Mod, GroupName, Properties),
- call(fun call_generic/3, Config, [pre_init_per_group, GroupName]);
-init_tc(_Mod, {end_per_group, GroupName, _}, Config) ->
- call(fun call_generic/3, Config, [pre_end_per_group, GroupName]);
-init_tc(_Mod, {init_per_testcase,TC}, Config) ->
- call(fun call_generic/3, Config, [pre_init_per_testcase, TC]);
-init_tc(_Mod, {end_per_testcase,TC}, Config) ->
- call(fun call_generic/3, Config, [pre_end_per_testcase, TC]);
-init_tc(_Mod, TC = error_in_suite, Config) ->
- call(fun call_generic/3, Config, [pre_init_per_testcase, TC]).
+ call(fun call_generic_fallback/3, Config,
+ [pre_init_per_group, Mod, GroupName]);
+init_tc(Mod, {end_per_group, GroupName, _}, Config) ->
+ call(fun call_generic_fallback/3, Config,
+ [pre_end_per_group, Mod, GroupName]);
+init_tc(Mod, {init_per_testcase,TC}, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]);
+init_tc(Mod, {end_per_testcase,TC}, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]);
+init_tc(Mod, TC = error_in_suite, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]).
%% @doc Called as each test case is completed. This includes all configuration
%% tests.
@@ -126,23 +128,23 @@ end_tc(Mod, init_per_suite, Config, _Result, Return) ->
end_tc(Mod, end_per_suite, Config, Result, _Return) ->
call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config],
'$ct_no_change');
-end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
- call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config],
- '$ct_no_change');
+end_tc(Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
+ call(fun call_generic_fallback/3, Return,
+ [post_init_per_group, Mod, GroupName, Config], '$ct_no_change');
end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) ->
- Res = call(fun call_generic/3, Result,
- [post_end_per_group, GroupName, Config], '$ct_no_change'),
+ Res = call(fun call_generic_fallback/3, Result,
+ [post_end_per_group, Mod, GroupName, Config], '$ct_no_change'),
maybe_stop_locker(Mod, GroupName, Properties),
Res;
-end_tc(_Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_init_per_testcase, TC, Config],
- '$ct_no_change');
-end_tc(_Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
- '$ct_no_change');
-end_tc(_Mod, TC = error_in_suite, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
- '$ct_no_change').
+end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_init_per_testcase, Mod, TC, Config], '$ct_no_change');
+end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_end_per_testcase, Mod, TC, Config], '$ct_no_change');
+end_tc(Mod, TC = error_in_suite, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_end_per_testcase, Mod, TC, Config], '$ct_no_change').
%% Case = TestCase | {TestCase,GroupName}
@@ -181,15 +183,21 @@ call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) ->
{[],Hook}.
call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook,
- Reason, [Function, _Suite | Args]) ->
+ Reason, [Function | Args]) ->
NewState = catch_apply(Mod,Function, Args ++ [Reason, State],
- State),
+ State, true),
{Reason, Hook#ct_hook_config{ state = NewState } }.
-call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
- Value, [Function | Args]) ->
+call_generic(Hook, Value, Meta) ->
+ do_call_generic(Hook, Value, Meta, false).
+
+call_generic_fallback(Hook, Value, Meta) ->
+ do_call_generic(Hook, Value, Meta, true).
+
+do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
+ Value, [Function | Args], Fallback) ->
{NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State],
- {Value,State}),
+ {Value,State}, Fallback),
{NewValue, Hook#ct_hook_config{ state = NewState } }.
%% Generic call function
@@ -257,15 +265,15 @@ remove(Key,List) when is_list(List) ->
remove(_, Else) ->
Else.
-%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc
-scope([pre_init_per_testcase, TC|_]) ->
- [post_init_per_testcase, TC];
-scope([pre_end_per_testcase, TC|_]) ->
- [post_end_per_testcase, TC];
-scope([pre_init_per_group, GroupName|_]) ->
- [post_end_per_group, GroupName];
-scope([post_init_per_group, GroupName|_]) ->
- [post_end_per_group, GroupName];
+%% Translate scopes, i.e. is_tuplenit_per_group,group1 -> end_per_group,group1 etc
+scope([pre_init_per_testcase, SuiteName, TC|_]) ->
+ [post_init_per_testcase, SuiteName, TC];
+scope([pre_end_per_testcase, SuiteName, TC|_]) ->
+ [post_end_per_testcase, SuiteName, TC];
+scope([pre_init_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
+scope([post_init_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
scope([pre_init_per_suite, SuiteName|_]) ->
[post_end_per_suite, SuiteName];
scope([post_init_per_suite, SuiteName|_]) ->
@@ -273,14 +281,29 @@ scope([post_init_per_suite, SuiteName|_]) ->
scope(init) ->
none.
-terminate_if_scope_ends(HookId, [on_tc_skip,_Suite,{end_per_group,Name}],
+strip_config([post_init_per_testcase, SuiteName, TC|_]) ->
+ [post_init_per_testcase, SuiteName, TC];
+strip_config([post_end_per_testcase, SuiteName, TC|_]) ->
+ [post_end_per_testcase, SuiteName, TC];
+strip_config([post_init_per_group, SuiteName, GroupName|_]) ->
+ [post_init_per_group, SuiteName, GroupName];
+strip_config([post_end_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
+strip_config([post_init_per_suite, SuiteName|_]) ->
+ [post_init_per_suite, SuiteName];
+strip_config([post_end_per_suite, SuiteName|_]) ->
+ [post_end_per_suite, SuiteName];
+strip_config(Other) ->
+ Other.
+
+
+terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}],
Hooks) ->
- terminate_if_scope_ends(HookId, [post_end_per_group, Name], Hooks);
+ terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks);
terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) ->
terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks);
-terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] ->
- terminate_if_scope_ends(HookId,[Function,Tag],Hooks);
-terminate_if_scope_ends(HookId, Function, Hooks) ->
+terminate_if_scope_ends(HookId, Function0, Hooks) ->
+ Function = strip_config(Function0),
case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of
#ct_hook_config{ id = HookId, scope = Function} = Hook ->
terminate([Hook]),
@@ -384,21 +407,29 @@ pos(Id,[_|Rest],Num) ->
catch_apply(M,F,A, Default) ->
+ catch_apply(M,F,A,Default,false).
+catch_apply(M,F,A, Default, Fallback) ->
+ not erlang:module_loaded(M) andalso (catch M:module_info()),
+ case erlang:function_exported(M,F,length(A)) of
+ false when Fallback ->
+ catch_apply(M,F,tl(A),Default,false);
+ false ->
+ Default;
+ true ->
+ catch_apply(M,F,A)
+ end.
+
+catch_apply(M,F,A) ->
try
- erlang:apply(M,F,A)
+ erlang:apply(M,F,A)
catch _:Reason ->
- case erlang:get_stacktrace() of
- %% Return the default if it was the CTH module which did not have the function.
- [{M,F,A,_}|_] when Reason == undef ->
- Default;
- Trace ->
- ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p",
- [error,{Reason,Trace}]),
- throw({error_in_cth_call,
- lists:flatten(
- io_lib:format("~w:~w/~w CTH call failed",
- [M,F,length(A)]))})
- end
+ Trace = erlang:get_stacktrace(),
+ ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p",
+ [error,{Reason,Trace}]),
+ throw({error_in_cth_call,
+ lists:flatten(
+ io_lib:format("~w:~w/~w CTH call failed",
+ [M,F,length(A)]))})
end.
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index a049ef5695..cac176de3a 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -76,8 +76,8 @@
abort_if_missing_suites,
silent_connections = [],
stylesheet,
- multiply_timetraps = 1,
- scale_timetraps = false,
+ multiply_timetraps,
+ scale_timetraps,
create_priv_dir,
testspec_files = [],
current_testspec,
@@ -264,11 +264,11 @@ script_start1(Parent, Args) ->
[], Args),
Verbosity = verbosity_args2opts(Args),
MultTT = get_start_opt(multiply_timetraps,
- fun([MT]) -> list_to_integer(MT) end, 1, Args),
+ fun([MT]) -> list_to_integer(MT) end, Args),
ScaleTT = get_start_opt(scale_timetraps,
fun([CT]) -> list_to_atom(CT);
([]) -> true
- end, false, Args),
+ end, Args),
CreatePrivDir = get_start_opt(create_priv_dir,
fun([PD]) -> list_to_atom(PD);
([]) -> auto_per_tc
@@ -1055,8 +1055,8 @@ run_test2(StartOpts) ->
CoverStop = get_start_opt(cover_stop, value, StartOpts),
%% timetrap manipulation
- MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts),
- ScaleTT = get_start_opt(scale_timetraps, value, false, StartOpts),
+ MultiplyTT = get_start_opt(multiply_timetraps, value, StartOpts),
+ ScaleTT = get_start_opt(scale_timetraps, value, StartOpts),
%% create unique priv dir names
CreatePrivDir = get_start_opt(create_priv_dir, value, StartOpts),
@@ -2280,8 +2280,19 @@ do_run_test(Tests, Skip, Opts0) ->
_Lower ->
ok
end,
- test_server_ctrl:multiply_timetraps(Opts0#opts.multiply_timetraps),
- test_server_ctrl:scale_timetraps(Opts0#opts.scale_timetraps),
+
+ case Opts0#opts.multiply_timetraps of
+ undefined -> MultTT = 1;
+ MultTT -> MultTT
+ end,
+ case Opts0#opts.scale_timetraps of
+ undefined -> ScaleTT = false;
+ ScaleTT -> ScaleTT
+ end,
+ ct_logs:log("TEST INFO","Timetrap time multiplier = ~w~n"
+ "Timetrap scaling enabled = ~w", [MultTT,ScaleTT]),
+ test_server_ctrl:multiply_timetraps(MultTT),
+ test_server_ctrl:scale_timetraps(ScaleTT),
test_server_ctrl:create_priv_dir(choose_val(
Opts0#opts.create_priv_dir,
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 991abb0666..466a2c7658 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -26,7 +26,8 @@
-export([prepare_tests/1, prepare_tests/2,
collect_tests_from_list/2, collect_tests_from_list/3,
- collect_tests_from_file/2, collect_tests_from_file/3]).
+ collect_tests_from_file/2, collect_tests_from_file/3,
+ get_tests/1]).
-export([testspec_rec2list/1, testspec_rec2list/2]).
@@ -803,6 +804,31 @@ list_nodes(#testspec{nodes=NodeRefs}) ->
lists:map(fun({_Ref,Node}) -> Node end, NodeRefs).
+%%%-----------------------------------------------------------------
+%%% Parse the given test specs and return the complete set of specs
+%%% and tests to run/skip.
+%%% [Spec1,Spec2,...] means create separate tests per spec
+%%% [[Spec1,Spec2,...]] means merge all specs into one
+-spec get_tests(Specs) -> {ok,[{Specs,Tests}]} | {error,Reason} when
+ Specs :: [string()] | [[string()]],
+ Tests :: {Node,Run,Skip},
+ Node :: atom(),
+ Run :: {Dir,Suites,Cases},
+ Skip :: {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment},
+ Dir :: string(),
+ Suites :: atom | [atom()] | all,
+ Cases :: atom | [atom()] | all,
+ Comment :: string(),
+ Reason :: term().
+
+get_tests(Specs) ->
+ case collect_tests_from_file(Specs,true) of
+ Tests when is_list(Tests) ->
+ {ok,[{S,prepare_tests(R)} || {S,R} <- Tests]};
+ Error ->
+ Error
+ end.
+
%% -----------------------------------------------------
%% / \
%% | When adding test/config terms, remember to update |
@@ -1132,6 +1158,11 @@ handle_data(verbosity,Node,VLvls,_Spec) when is_list(VLvls) ->
VLvls1 = lists:map(fun(VLvl = {_Cat,_Lvl}) -> VLvl;
(Lvl) -> {'$unspecified',Lvl} end, VLvls),
[{Node,VLvls1}];
+handle_data(multiply_timetraps,Node,Mult,_Spec) when is_integer(Mult) ->
+ [{Node,Mult}];
+handle_data(scale_timetraps,Node,Scale,_Spec) when Scale == true;
+ Scale == false ->
+ [{Node,Scale}];
handle_data(silent_connections,Node,all,_Spec) ->
[{Node,[all]}];
handle_data(silent_connections,Node,Conn,_Spec) when is_atom(Conn) ->
@@ -1150,6 +1181,8 @@ should_be_added(Tag,Node,_Data,Spec) ->
Tag == label; Tag == auto_compile;
Tag == abort_if_missing_suites;
Tag == stylesheet; Tag == verbosity;
+ Tag == multiply_timetraps;
+ Tag == scale_timetraps;
Tag == silent_connections ->
lists:keymember(ref2node(Node,Spec#testspec.nodes),1,
read_field(Spec,Tag)) == false;
diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl
index 883da0da0a..ce8852b3ea 100644
--- a/lib/common_test/src/cth_conn_log.erl
+++ b/lib/common_test/src/cth_conn_log.erl
@@ -54,8 +54,8 @@
-include_lib("common_test/include/ct.hrl").
-export([init/2,
- pre_init_per_testcase/3,
- post_end_per_testcase/4]).
+ pre_init_per_testcase/4,
+ post_end_per_testcase/5]).
%%----------------------------------------------------------------------
%% Exported types
@@ -104,7 +104,7 @@ get_log_opts(Mod,Opts) ->
Hosts = proplists:get_value(hosts,Opts,[]),
{LogType,Hosts}.
-pre_init_per_testcase(TestCase,Config,CthState) ->
+pre_init_per_testcase(_Suite,TestCase,Config,CthState) ->
Logs =
lists:map(
fun({ConnMod,{LogType,Hosts}}) ->
@@ -158,7 +158,7 @@ pre_init_per_testcase(TestCase,Config,CthState) ->
ct_util:update_testdata(?MODULE, Update, [create]),
{Config,CthState}.
-post_end_per_testcase(TestCase,_Config,Return,CthState) ->
+post_end_per_testcase(_Suite,TestCase,_Config,Return,CthState) ->
Update =
fun(PrevUsers) ->
case lists:delete(TestCase, PrevUsers) of
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 6d77d7ee9e..eda090d4f5 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -28,10 +28,10 @@
%% CTH Callbacks
-export([id/1, init/2,
pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4,
- pre_init_per_group/3, post_init_per_group/4,
- pre_end_per_group/3, post_end_per_group/4,
- pre_init_per_testcase/3, post_init_per_testcase/4,
- pre_end_per_testcase/3, post_end_per_testcase/4]).
+ pre_init_per_group/4, post_init_per_group/5,
+ pre_end_per_group/4, post_end_per_group/5,
+ pre_init_per_testcase/4, post_init_per_testcase/5,
+ pre_end_per_testcase/4, post_end_per_testcase/5]).
%% Event handler Callbacks
-export([init/1,
@@ -71,11 +71,11 @@ post_end_per_suite(_Suite, Config, Return, State) ->
set_curr_func(undefined, Config),
{Return, State}.
-pre_init_per_group(Group, Config, State) ->
+pre_init_per_group(_Suite, Group, Config, State) ->
set_curr_func({group,Group,init_per_group}, Config),
{Config, State}.
-post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) ->
+post_init_per_group(_Suite, Group, Config, Result, tc_log_async) when is_list(Config) ->
case lists:member(parallel,proplists:get_value(
tc_group_properties,Config,[])) of
true ->
@@ -83,33 +83,33 @@ post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) ->
false ->
{Result, tc_log_async}
end;
-post_init_per_group(_Group, _Config, Result, State) ->
+post_init_per_group(_Suite, _Group, _Config, Result, State) ->
{Result, State}.
-pre_init_per_testcase(TC, Config, State) ->
+pre_init_per_testcase(_Suite, TC, Config, State) ->
set_curr_func(TC, Config),
{Config, State}.
-post_init_per_testcase(_TC, _Config, Return, State) ->
+post_init_per_testcase(_Suite, _TC, _Config, Return, State) ->
{Return, State}.
-pre_end_per_testcase(_TC, Config, State) ->
+pre_end_per_testcase(_Suite, _TC, Config, State) ->
{Config, State}.
-post_end_per_testcase(_TC, _Config, Result, State) ->
+post_end_per_testcase(_Suite, _TC, _Config, Result, State) ->
%% Make sure that the event queue is flushed
%% before ending this test case.
gen_event:call(error_logger, ?MODULE, flush, 300000),
{Result, State}.
-pre_end_per_group(Group, Config, {tc_log, Group}) ->
+pre_end_per_group(_Suite, Group, Config, {tc_log, Group}) ->
set_curr_func({group,Group,end_per_group}, Config),
{Config, set_log_func(tc_log_async)};
-pre_end_per_group(Group, Config, State) ->
+pre_end_per_group(_Suite, Group, Config, State) ->
set_curr_func({group,Group,end_per_group}, Config),
{Config, State}.
-post_end_per_group(_Group, Config, Return, State) ->
+post_end_per_group(_Suite, _Group, Config, Return, State) ->
set_curr_func({group,undefined}, Config),
{Return, State}.
diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl
index 59b916851e..c4941948cc 100644
--- a/lib/common_test/src/cth_surefire.erl
+++ b/lib/common_test/src/cth_surefire.erl
@@ -33,16 +33,16 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
--export([pre_init_per_group/3]).
--export([post_init_per_group/4]).
--export([pre_end_per_group/3]).
--export([post_end_per_group/4]).
+-export([pre_init_per_group/4]).
+-export([post_init_per_group/5]).
+-export([pre_end_per_group/4]).
+-export([post_end_per_group/5]).
--export([pre_init_per_testcase/3]).
--export([post_end_per_testcase/4]).
+-export([pre_init_per_testcase/4]).
+-export([post_end_per_testcase/5]).
--export([on_tc_fail/3]).
--export([on_tc_skip/3]).
+-export([on_tc_fail/4]).
+-export([on_tc_skip/4]).
-export([terminate/1]).
@@ -116,29 +116,29 @@ pre_end_per_suite(_Suite,Config,State) ->
post_end_per_suite(_Suite,Config,Result,State) ->
{Result, end_tc(end_per_suite,Config,Result,State)}.
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(_Suite,Group,Config,State) ->
{Config, init_tc(State#state{ curr_group = [Group|State#state.curr_group]},
Config)}.
-post_init_per_group(_Group,Config,Result,State) ->
+post_init_per_group(_Suite,_Group,Config,Result,State) ->
{Result, end_tc(init_per_group,Config,Result,State)}.
-pre_end_per_group(_Group,Config,State) ->
+pre_end_per_group(_Suite,_Group,Config,State) ->
{Config, init_tc(State, Config)}.
-post_end_per_group(_Group,Config,Result,State) ->
+post_end_per_group(_Suite,_Group,Config,Result,State) ->
NewState = end_tc(end_per_group, Config, Result, State),
{Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}.
-pre_init_per_testcase(_TC,Config,State) ->
+pre_init_per_testcase(_Suite,_TC,Config,State) ->
{Config, init_tc(State, Config)}.
-post_end_per_testcase(TC,Config,Result,State) ->
+post_end_per_testcase(_Suite,TC,Config,Result,State) ->
{Result, end_tc(TC,Config, Result,State)}.
-on_tc_fail(_TC, _Res, State = #state{test_cases = []}) ->
+on_tc_fail(_Suite,_TC, _Res, State = #state{test_cases = []}) ->
State;
-on_tc_fail(_TC, Res, State) ->
+on_tc_fail(_Suite,_TC, Res, State) ->
TCs = State#state.test_cases,
TC = hd(TCs),
NewTC = TC#testcase{
@@ -146,10 +146,9 @@ on_tc_fail(_TC, Res, State) ->
{fail,lists:flatten(io_lib:format("~p",[Res]))} },
State#state{ test_cases = [NewTC | tl(TCs)]}.
-on_tc_skip({ConfigFunc,_GrName},{Type,_Reason} = Res, State0)
- when Type == tc_auto_skip; Type == tc_user_skip ->
- on_tc_skip(ConfigFunc, Res, State0);
-on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip ->
+on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) ->
+ on_tc_skip(Suite,ConfigFunc, Res, State);
+on_tc_skip(Suite,Tc, Res, State0) ->
TcStr = atom_to_list(Tc),
State =
case State0#state.test_cases of
@@ -158,11 +157,7 @@ on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip ->
_ ->
State0
end,
- do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[])));
-on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) ->
- State;
-on_tc_skip(_Tc, Res, State) ->
- do_tc_skip(Res, State).
+ do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(set_suite(Suite,State),[]))).
do_tc_skip(Res, State) ->
TCs = State#state.test_cases,
@@ -209,6 +204,12 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite,
result = passed }|
State#state.test_cases],
tc_log = ""}. % so old tc_log is not set if next is on_tc_skip
+
+set_suite(Suite,#state{curr_suite=undefined}=State) ->
+ State#state{curr_suite=Suite, curr_suite_ts=?now};
+set_suite(_,State) ->
+ State.
+
close_suite(#state{ test_cases = [] } = State) ->
State;
close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) ->
@@ -228,7 +229,8 @@ close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) ->
testcases = lists:reverse(TCs),
log = SuiteLog,
url = SuiteUrl},
- State#state{ test_cases = [],
+ State#state{ curr_suite = undefined,
+ test_cases = [],
test_suites = [Suite | State#state.test_suites]}.
terminate(State = #state{ test_cases = [] }) ->
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index 924086f2bd..be49191f2e 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -778,9 +778,9 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid,
%% if init_per_testcase fails, the test case
%% should be skipped
try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[CurrConf]}, Why),
- do_init_tc_call(Mod,{end_per_testcase,Func},
+ do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
[CurrConf],{ok,[CurrConf]}),
- do_end_tc_call(Mod,{end_per_testcase,Func},
+ do_end_tc_call(Mod,{end_per_testcase_not_run,Func},
{Pid,Skip,[CurrConf]}, Why) end of
_ -> ok
catch
@@ -1151,14 +1151,14 @@ do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) ->
Args
end,
EPTCInitRes =
- case do_init_tc_call(Mod,{end_per_testcase,Func},
+ case do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
IPTCEndRes,Return) of
{ok,EPTCInitConfig} when is_list(EPTCInitConfig) ->
{Return,EPTCInitConfig};
_ ->
- Return
+ {Return,IPTCEndRes}
end,
- do_end_tc_call1(Mod, {end_per_testcase,Func},
+ do_end_tc_call1(Mod, {end_per_testcase_not_run,Func},
EPTCInitRes, Return);
_Ok ->
do_end_tc_call1(Mod, IPTC, Res, Return)
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index b52e4bef9b..39c523f8b3 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -2051,17 +2051,21 @@ add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
%% we'll add end_per_suite here even if it's not exported
%% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}];
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" end_per_suite if it exists
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
[{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
false ->
[{conf,LastRef,[],{LastMod,end_per_suite}}]
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ [{conf,LastRef,[],{LastMod,end_per_suite}}]
end.
do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
@@ -2070,11 +2074,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
_ -> ok
end,
{Init,NextMod,NextRef} =
- case erlang:function_exported(Mod, init_per_suite, 1) of
- true ->
- Ref = make_ref(),
- {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
- false ->
+ case {erlang:function_exported(Mod, init_per_suite, 1),
+ erlang:function_exported(Mod, end_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" init_per_suite if it exists
case erlang:function_exported(FwMod, init_per_suite, 1) of
true ->
@@ -2083,8 +2085,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
{FwMod,init_per_suite}}],Mod,Ref};
false ->
{[],Mod,undefined}
- end
-
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ Ref = make_ref(),
+ {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref}
end,
Cases =
if LastRef==undefined ->
@@ -2094,10 +2101,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
true ->
%% we'll add end_per_suite here even if it's not exported
%% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" end_per_suite if it exists
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
@@ -2105,8 +2111,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
{FwMod,end_per_suite}}|Init];
false ->
[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
- end
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
+ end
end,
{Cases,NextMod,NextRef}.
@@ -2115,11 +2126,9 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
No when No==undefined ; No==skipped_suite ->
{[],Mod,skipped_suite};
_Ref ->
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- {[{conf,LastRef,[],{LastMod,end_per_suite}}],
- Mod,skipped_suite};
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
%% let's call "fake" end_per_suite if it exists
@@ -2128,7 +2137,13 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
false ->
{[{conf,LastRef,[],{LastMod,end_per_suite}}],
Mod,skipped_suite}
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+ Mod,skipped_suite}
end
end.
@@ -2924,22 +2939,21 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status)
exit(framework_error);
%% sequential execution of test case finished
{Time,RetVal,_} ->
+ RetTag =
+ if is_tuple(RetVal) -> element(1,RetVal);
+ true -> undefined
+ end,
{Failed,Status1} =
- case Time of
- died ->
- {true,update_status(failed, Mod, Func, Status)};
- _ when is_tuple(RetVal) ->
- case element(1, RetVal) of
- R when R=='EXIT'; R==failed ->
- {true,update_status(failed, Mod, Func, Status)};
- R when R==skip; R==skipped ->
- {false,update_status(skipped, Mod, Func, Status)};
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end;
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end,
+ case RetTag of
+ Skip when Skip==skip; Skip==skipped ->
+ {false,update_status(skipped, Mod, Func, Status)};
+ Fail when Fail=='EXIT'; Fail==failed ->
+ {true,update_status(failed, Mod, Func, Status)};
+ _ when Time==died, RetVal=/=ok ->
+ {true,update_status(failed, Mod, Func, Status)};
+ _ ->
+ {false,update_status(ok, Mod, Func, Status)}
+ end,
case check_prop(sequence, Mode) of
false ->
stop_minor_log_file(),
@@ -3794,7 +3808,15 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
{died,{timetrap_timeout,TimetrapTimeout}} ->
progress(failed, Num, Mod, Func, GrName, Loc,
timetrap_timeout, TimetrapTimeout, Comment, Style);
- {died,Reason} ->
+ {died,{Skip,Reason}} when Skip==skip; Skip==skipped ->
+ %% died in init_per_testcase
+ progress(skip, Num, Mod, Func, GrName, Loc, Reason,
+ Time, Comment, Style);
+ {died,Reason} when Reason=/=ok ->
+ %% (If Reason==ok it means that process died in
+ %% end_per_testcase after successfully completing the
+ %% test case itself - then we shall not fail, but a
+ %% warning will be issued in the comment field.)
progress(failed, Num, Mod, Func, GrName, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
@@ -3943,6 +3965,9 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
{ReportTag,Reason1}}]),
+ TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
+ true -> "~w"
+ end, [Time]),
ReasonStr = escape_chars(reason_to_string(Reason1)),
ReasonStr1 = lists:flatten([string:strip(S,left) ||
S <- string:tokens(ReasonStr,[$\n])]),
@@ -3957,10 +3982,10 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
_ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")"
end,
print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
+ "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
"<td><font color=\"~ts\">SKIPPED</font></td>"
"<td>~ts~ts</td></tr>\n",
- [Time,Color,ReasonStr2,Comment1]),
+ [TimeStr,Color,ReasonStr2,Comment1]),
FormatLoc = test_server_sup:format_loc(Loc),
print(minor, "=== Location: ~ts", [FormatLoc]),
print(minor, "=== Reason: ~ts", [ReasonStr1]),
@@ -4098,6 +4123,9 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
Comment0, {St0,St1}) ->
print(minor, "successfully completed test case", []),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]),
+ TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
+ true -> "~w"
+ end, [Time]),
Comment =
case RetVal of
{comment,RetComment} ->
@@ -4116,10 +4144,10 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
end,
print(major, "=elapsed ~p", [Time]),
print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
+ "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
"<td><font color=\"green\">Ok</font></td>"
"~ts</tr>\n",
- [Time,Comment]),
+ [TimeStr,Comment]),
print(minor,
escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])),
[]),
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_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl
index fae23484e6..621f3b6d2d 100644
--- a/lib/common_test/test/ct_error_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE.erl
@@ -1531,17 +1531,17 @@ test_events(config_func_errors) ->
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}},
- {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,test_stats,{0,0,{0,1}}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}},
- {?eh,test_stats,{0,2,{0,0}}},
+ {?eh,test_stats,{1,0,{0,1}}},
[{?eh,tc_start,{config_func_error_1_SUITE,{init_per_group,g1,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g1,[]},ok}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}},
- {?eh,test_stats,{0,3,{0,0}}},
+ {?eh,test_stats,{1,0,{0,2}}},
{?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g1,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g1,[]},ok}}],
@@ -1549,7 +1549,7 @@ test_events(config_func_errors) ->
{?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g2,[]},ok}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}},
- {?eh,test_stats,{0,4,{0,0}}},
+ {?eh,test_stats,{2,0,{0,2}}},
{?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g2,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g2,[]},ok}}],
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 690d0af1bb..93bcb8fe52 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -70,22 +70,25 @@ 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_pre_init_tc_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
+ no_init_suite_config, no_init_config, no_end_config,
+ failed_sequence, repeat_force_stop, config_clash,
+ callbacks_on_skip, fallback, data_dir, cth_log
]
).
@@ -96,10 +99,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 +122,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).
@@ -190,6 +193,10 @@ skip_post_suite_cth(Config) when is_list(Config) ->
do_test(skip_post_suite_cth, "ct_cth_empty_SUITE.erl",
[skip_post_suite_cth],Config).
+skip_pre_init_tc_cth(Config) ->
+ do_test(skip_pre_init_tc_cth, "ct_cth_empty_SUITE.erl",
+ [skip_pre_init_tc_cth],Config).
+
recover_post_suite_cth(Config) when is_list(Config) ->
do_test(recover_post_suite_cth, "ct_cth_fail_per_suite_SUITE.erl",
[recover_post_suite_cth],Config).
@@ -205,7 +212,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).
@@ -223,13 +230,24 @@ no_config(Config) when is_list(Config) ->
do_test(no_config, "ct_no_config_SUITE.erl",
[verify_config_cth],Config).
+no_init_suite_config(Config) when is_list(Config) ->
+ do_test(no_init_suite_config, "ct_no_init_suite_config_SUITE.erl",
+ [empty_cth],Config).
+
+no_init_config(Config) when is_list(Config) ->
+ do_test(no_init_config, "ct_no_init_config_SUITE.erl",[empty_cth],Config).
+
+no_end_config(Config) when is_list(Config) ->
+ do_test(no_end_config, "ct_no_end_config_SUITE.erl",[empty_cth],Config).
+
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 =
@@ -253,29 +271,57 @@ cth_log(Config) when is_list(Config) ->
end, UnexpIoLogs),
ok.
+%% OTP-10599 adds the Suite argument as first argument to all hook
+%% callbacks that did not have a Suite argument from before. This test
+%% checks that ct_hooks will fall back to old versions of callbacks if
+%% new versions are not exported.
+fallback(Config) ->
+ do_test(fallback, "all_hook_callbacks_SUITE.erl",[fallback_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped in different ways
+callbacks_on_skip(Config) ->
+ do_test(callbacks_on_skip, {spec,"skip.spec"},[skip_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped due to failed sequence
+failed_sequence(Config) ->
+ do_test(failed_sequence, "seq_SUITE.erl", [skip_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped due to {force_stop,skip_rest} option
+repeat_force_stop(Config) ->
+ do_test(repeat_force_stop, "repeat_SUITE.erl", [skip_cth], Config, ok, 2,
+ [{force_stop,skip_rest},{duration,"000009"}]).
+
+%% Test that expected callbacks, and only those, are called when a test
+%% are fails due to clash in config alias names
+config_clash(Config) ->
+ do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config).
%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
-do_test(Tag, SWC, CTHs, Config) ->
- do_test(Tag, SWC, CTHs, Config, ok).
-do_test(Tag, SWC, CTHs, Config, {error,_} = Res) ->
- do_test(Tag, SWC, CTHs, Config, Res, 1);
-do_test(Tag, SWC, CTHs, Config, Res) ->
- do_test(Tag, SWC, CTHs, Config, Res, 2).
+do_test(Tag, WTT, CTHs, Config) ->
+ do_test(Tag, WTT, CTHs, Config, ok).
+do_test(Tag, WTT, CTHs, Config, {error,_} = Res) ->
+ do_test(Tag, WTT, CTHs, Config, Res, 1,[]);
+do_test(Tag, WTT, CTHs, Config, Res) ->
+ do_test(Tag, WTT, CTHs, Config, Res, 2,[]).
-do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) ->
-
+do_test(Tag, WhatToTest, CTHs, Config, Res, EC, ExtraOpts) when is_list(WhatToTest) ->
+ do_test(Tag, {suite,WhatToTest}, CTHs, Config, Res, EC, ExtraOpts);
+do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) ->
DataDir = ?config(data_dir, Config),
- Suites = filelib:wildcard(
- filename:join([DataDir,"cth/tests",SuiteWildCard])),
- {Opts,ERPid} = setup([{suite,Suites},
- {ct_hooks,CTHs},{label,Tag}], Config),
+ Files = filelib:wildcard(
+ filename:join([DataDir,"cth/tests",Wildcard])),
+ {Opts,ERPid} =
+ setup([{WhatTag,Files},{ct_hooks,CTHs},{label,Tag}|ExtraOpts], Config),
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),
@@ -323,12 +369,12 @@ test_events(one_empty_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{empty_cth,post_init_per_testcase,[test_case,'$proplist','_',[]]}},
- {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,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',[]]}},
@@ -355,12 +401,12 @@ test_events(two_empty_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,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 +448,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'}},
@@ -423,10 +469,10 @@ test_events(minimal_and_maximal_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,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 +498,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,[]}
];
@@ -512,10 +558,10 @@ test_events(scope_per_suite_cth) ->
{?eh,tc_done,{ct_scope_per_suite_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_per_suite_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_cth_SUITE,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',[]]}},
@@ -538,10 +584,10 @@ test_events(scope_suite_cth) ->
{?eh,tc_done,{ct_scope_suite_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_suite_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_cth_SUITE,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','_',[]]}},
@@ -561,20 +607,20 @@ test_events(scope_per_group_cth) ->
[{?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,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,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,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,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,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,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'}},
@@ -592,10 +638,10 @@ test_events(scope_per_suite_state_cth) ->
{?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_per_suite_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,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_state_cth_SUITE,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]]}},
@@ -618,10 +664,10 @@ test_events(scope_suite_state_cth) ->
{?eh,tc_done,{ct_scope_suite_state_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_suite_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,cth,{'_',pre_init_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_state_cth_SUITE,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]]}},
@@ -641,20 +687,20 @@ test_events(scope_per_group_state_cth) ->
[{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]}}},
{?eh,cth,{'_',id,[[test]]}},
{?eh,cth,{'_',init,['_',[test]]}},
- {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}},
+ {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_state_cth_SUITE,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,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_state_cth_SUITE,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,{'_',pre_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_state_cth_SUITE,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 +712,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',
@@ -674,27 +720,27 @@ test_events(fail_pre_suite_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,
{failed, {error,"Test failure"}}}},
{?eh,cth,{'_',on_tc_fail,
- [init_per_suite,{failed,"Test failure"},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,"Test failure",[]]}},
+
-
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
{?eh,cth,{'_',on_tc_skip,
- [test_case, {tc_auto_skip,
+ [ct_cth_empty_SUITE,test_case, {tc_auto_skip,
{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"}}}}},
{?eh,cth,{'_',on_tc_skip,
- [end_per_suite, {tc_auto_skip,
+ [ct_cth_empty_SUITE,end_per_suite, {tc_auto_skip,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}},[]]}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth, {'_',terminate,[[]]}},
{?eh,stop_logging,[]}
@@ -727,17 +773,17 @@ test_events(fail_post_suite_cth) ->
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,
{failed,{error,"Test failure"}}}},
- {?eh,cth,{'_',on_tc_fail,[init_per_suite, {failed,"Test failure"}, []]}},
+ {?eh,cth,{'_',on_tc_fail,[ct_cth_empty_SUITE,init_per_suite, "Test failure", []]}},
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
- {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}},
-
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,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"}}}}},
- {?eh,cth,{'_',on_tc_skip,[end_per_suite,{tc_auto_skip,'_'},[]]}},
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,end_per_suite,{tc_auto_skip,'_'},[]]}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth, {'_',terminate,[[]]}},
@@ -754,11 +800,11 @@ test_events(skip_pre_suite_cth) ->
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}},
{?eh,cth,{'_',on_tc_skip,
- [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}},
{?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,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,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,31 +818,33 @@ 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,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,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,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,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,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},
{skipped,"Test skip"}}}],
- {?eh,cth,{'_',on_tc_skip,[{end_per_group,group1},
- {tc_user_skip,{skipped,"Test skip"}},
+ {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE,
+ {end_per_group,group1},
+ {tc_user_skip,"Test skip"},
[]]}},
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,
{skipped,"Test skip"}}},
- {?eh,cth,{'_',on_tc_skip,[end_per_suite,
- {tc_user_skip,{skipped,"Test skip"}},
+ {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE,
+ end_per_suite,
+ {tc_user_skip,"Test skip"},
[]]}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[[]]}},
@@ -808,24 +856,59 @@ 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',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}},
{?eh,cth,{'_',on_tc_skip,
- [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}},
{?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,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,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,[]}
];
+test_events(skip_pre_init_tc_cth) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,['_',[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [ct_cth_empty_SUITE,test_case,'$proplist',
+ {skip,"Skipped in pre_init_per_testcase"},
+ []]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,test_case,
+ {skipped,"Skipped in pre_init_per_testcase"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_cth_empty_SUITE,test_case,
+ {tc_user_skip,"Skipped in pre_init_per_testcase"},
+ []]}},
+ {?eh,test_stats,{0,0,{1,0}}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_cth_empty_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
test_events(recover_post_suite_cth) ->
Suite = ct_cth_fail_per_suite_SUITE,
[
@@ -840,11 +923,11 @@ test_events(recover_post_suite_cth) ->
{?eh,tc_start,{Suite,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,
- [test_case, not_contains([tc_status]),[]]}},
+ [Suite,test_case, not_contains([tc_status]),[]]}},
{?eh,cth,{'_',post_end_per_testcase,
- [test_case, contains([tc_status]),'_',[]]}},
+ [Suite,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 +944,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([]),[]]}},
@@ -876,13 +959,15 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE, {init_per_group,group1,[]}}},
{?eh,cth,{'_',pre_init_per_group,
- [group1,contains(
+ [ct_update_config_SUITE,
+ group1,contains(
[post_init_per_suite,
init_per_suite,
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_init_per_group,
- [group1,
+ [ct_update_config_SUITE,
+ group1,
contains(
[post_init_per_suite,
init_per_suite,
@@ -898,7 +983,8 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,
- [test_case,contains(
+ [ct_update_config_SUITE,
+ test_case,contains(
[post_init_per_group,
init_per_group,
pre_init_per_group,
@@ -907,7 +993,8 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_end_per_testcase,
- [test_case,contains(
+ [ct_update_config_SUITE,
+ test_case,contains(
[init_per_testcase,
pre_init_per_testcase,
post_init_per_group,
@@ -921,7 +1008,8 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE, {end_per_group,group1,[]}}},
{?eh,cth,{'_',pre_end_per_group,
- [group1,contains(
+ [ct_update_config_SUITE,
+ group1,contains(
[post_init_per_group,
init_per_group,
pre_init_per_group,
@@ -930,7 +1018,8 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_end_per_group,
- [group1,
+ [ct_update_config_SUITE,
+ group1,
contains(
[pre_end_per_group,
post_init_per_group,
@@ -941,7 +1030,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 +1063,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(
@@ -1018,10 +1107,10 @@ test_events(options_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?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,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,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]]}},
@@ -1051,14 +1140,14 @@ test_events(same_id_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
{negative,
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}},
{negative,
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,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,
@@ -1094,11 +1183,13 @@ test_events(fail_n_skip_with_minimal_cth) ->
{?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case2,{skipped,"skip it"}}},
{?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,test_case3}},
{?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case3,{skipped,"skip it"}}},
- {?eh,cth,{empty_cth,on_tc_skip,[{test_case2,group2},
- {tc_user_skip,{skipped,"skip it"}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE,
+ {test_case2,group2},
+ {tc_user_skip,"skip it"},
[]]}},
- {?eh,cth,{empty_cth,on_tc_skip,[{test_case3,group2},
- {tc_user_skip,{skipped,"skip it"}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE,
+ {test_case3,group2},
+ {tc_user_skip,"skip it"},
[]]}},
{?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,{end_per_group,
group2,[parallel]}}},
@@ -1115,17 +1206,25 @@ test_events(fail_n_skip_with_minimal_cth) ->
];
test_events(prio_cth) ->
-
- GenPre = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_',State]}} ||
+ GenPre = fun(Func,States) when Func==pre_init_per_suite;
+ Func==pre_end_per_suite ->
+ [{?eh,cth,{'_',Func,['_','_',State]}} ||
+ State <- States];
+ (Func,States) ->
+ [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
State <- States]
end,
- GenPost = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
+ GenPost = fun(Func,States) when Func==post_init_per_suite;
+ Func==post_end_per_suite ->
+ [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
+ State <- States];
+ (Func,States) ->
+ [{?eh,cth,{'_',Func,['_','_','_','_',State]}} ||
State <- States]
- end,
-
+
+ end,
+
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++
@@ -1136,7 +1235,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 +1246,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 +1260,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],
@@ -1200,30 +1299,30 @@ test_events(no_config) ->
{?eh,tc_done,{ct_framework,init_per_suite,ok}},
{?eh,tc_start,{ct_no_config_SUITE,test_case_1}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_1,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_case_1,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_1,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_case_1,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_no_config_SUITE,test_case_1,ok}},
{?eh,test_stats,{1,0,{0,0}}},
[{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_init_per_group,
- [test_group,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_init_per_group,
- [test_group,'$proplist','$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_framework,
{init_per_group,test_group,'$proplist'},ok}},
{?eh,tc_start,{ct_no_config_SUITE,test_case_2}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_2,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_case_2,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_2,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_case_2,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_no_config_SUITE,test_case_2,ok}},
{?eh,test_stats,{2,0,{0,0}}},
{?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_end_per_group,
- [test_group,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_group,
- [test_group,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
@@ -1236,6 +1335,166 @@ test_events(no_config) ->
{?eh,stop_logging,[]}
];
+test_events(no_init_suite_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_no_init_suite_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_init_suite_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_init_suite_config_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_suite_config_SUITE,
+ init_per_suite,
+ {undef,'_'},[]]}},
+ {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,test_case,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_no_init_suite_config_SUITE,
+ test_case,
+ {tc_auto_skip,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_stats,{0,0,{0,1}}},
+ {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,end_per_suite,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_no_init_suite_config_SUITE,
+ end_per_suite,
+ {tc_auto_skip,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(no_init_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_no_init_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_init_config_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_no_init_config_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_init_config_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_init_config_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ [{?eh,tc_start,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [ct_no_init_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [ct_no_init_config_SUITE,test_group,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,{init_per_group,test_group,[]},
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_config_SUITE,
+ {init_per_group,test_group},
+ {undef,'_'},[]]}},
+ {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{test_case_2,test_group},
+ {failed,{ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE,
+ {test_case_2,test_group},
+ {tc_auto_skip,
+ {failed,
+ {ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_stats,{1,0,{0,1}}},
+ {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{end_per_group,test_group},
+ {failed,{ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE,
+ {end_per_group,test_group},
+ {tc_auto_skip,
+ {failed,
+ {ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}},
+ []]}}],
+ {?eh,tc_start,{ct_no_init_config_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(no_end_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_end_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_end_config_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_end_config_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_end_config_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ [{?eh,tc_start,{ct_no_end_config_SUITE,
+ {init_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,
+ {init_per_group,test_group,'$proplist'},ok}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,test_case_2}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_end_config_SUITE,test_case_2,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_end_config_SUITE,test_case_2,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,test_case_2,ok}},
+ {?eh,test_stats,{2,0,{0,0}}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,
+ {end_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_end_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,{end_per_group,test_group,[]},
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_end_config_SUITE,
+ {end_per_group,test_group},
+ {undef,'_'},[]]}}],
+ {?eh,tc_start,{ct_no_end_config_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [ct_no_end_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_no_end_config_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,end_per_suite,
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
test_events(data_dir) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
@@ -1250,30 +1509,30 @@ test_events(data_dir) ->
{?eh,tc_done,{ct_framework,init_per_suite,ok}},
{?eh,tc_start,{ct_data_dir_SUITE,test_case_1}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_data_dir_SUITE,test_case_1,ok}},
{?eh,test_stats,{1,0,{0,0}}},
[{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_init_per_group,
- [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_init_per_group,
- [test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_framework,
{init_per_group,test_group,'$proplist'},ok}},
{?eh,tc_start,{ct_data_dir_SUITE,test_case_2}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_data_dir_SUITE,test_case_2,ok}},
{?eh,test_stats,{2,0,{0,0}}},
{?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_end_per_group,
- [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_group,
- [test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
@@ -1300,16 +1559,654 @@ 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,[]}
];
+test_events(fallback) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,init_per_suite,ok}},
+
+ [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [fallback_nosuite,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [fallback_nosuite,test_group,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,
+ {init_per_group,test_group,'$proplist'},ok}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',ok,[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_end_per_group,
+ [fallback_nosuite,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_group,
+ [fallback_nosuite,test_group,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
+ {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist','_',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}},
+ {?eh,test_stats,{2,0,{0,0}}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,skip_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,skip_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [fallback_nosuite,skip_case,'$proplist',
+ {skip,"Skipped in init_per_testcase/2"},[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,skip_case,
+ {skipped,"Skipped in init_per_testcase/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [fallback_nosuite,skip_case,
+ {tc_user_skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,test_stats,{2,0,{1,0}}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(callbacks_on_skip) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{6,6,15}},
+
+ %% all_hook_callbacks_SUITE is skipped in spec
+ %% Only the on_tc_skip callback shall be called
+ {?eh,tc_user_skip,{all_hook_callbacks_SUITE,all,"Skipped in spec"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [all_hook_callbacks_SUITE,all,
+ {tc_user_skip,"Skipped in spec"},
+ []]}},
+ {?eh,test_stats,{0,0,{1,0}}},
+
+ %% skip_init_SUITE is skipped in its init_per_suite function
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_init_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_init_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_init_SUITE,
+ '$proplist',
+ {skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,tc_done,{skip_init_SUITE,init_per_suite,
+ {skipped,"Skipped in init_per_suite/1"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,init_per_suite,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,tc_user_skip,{skip_init_SUITE,test_case,"Skipped in init_per_suite/1"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,test_case,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,test_stats,{0,0,{2,0}}},
+ {?eh,tc_user_skip,{skip_init_SUITE,end_per_suite,
+ "Skipped in init_per_suite/1"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,end_per_suite,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+
+ %% skip_req_SUITE is auto-skipped since a 'require' statement
+ %% returned by suite/0 is not fulfilled.
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_req_SUITE,init_per_suite}},
+ {?eh,tc_done,{skip_req_SUITE,init_per_suite,
+ {auto_skipped,{require_failed_in_suite0,
+ {not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,init_per_suite,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_req_SUITE,test_case,{require_failed_in_suite0,
+ {not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,test_case,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,1}}},
+ {?eh,tc_auto_skip,{skip_req_SUITE,end_per_suite,
+ {require_failed_in_suite0,
+ {not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,end_per_suite,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+
+ %% skip_fail_SUITE is auto-skipped since the suite/0 function
+ %% retuns a faluty format.
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_fail_SUITE,init_per_suite}},
+ {?eh,tc_done,{skip_fail_SUITE,init_per_suite,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,init_per_suite,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_fail_SUITE,test_case,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,test_case,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,2}}},
+ {?eh,tc_auto_skip,{skip_fail_SUITE,end_per_suite,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,end_per_suite,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+
+ %% skip_group_SUITE
+ {?eh,tc_start,{skip_group_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ '_',
+ []]}},
+ {?eh,tc_done,{skip_group_SUITE,init_per_suite,ok}},
+
+ %% test_group_1 - auto_skip due to require failed
+ [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_1,[]}}},
+ {?eh,tc_done,
+ {skip_group_SUITE,{init_per_group,test_group_1,[]},
+ {auto_skipped,{require_failed,{not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_1},
+ {require_failed,{not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,3}}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_1},
+ {require_failed,{not_available,whatever}}}}],
+ %% The following appears to be outside of the group, but
+ %% that's only an implementation detail in
+ %% ct_test_support.erl - it does not know about events from
+ %% test suite specific hooks and regards the group ended with
+ %% the above tc_auto_skip-event for end_per_group.
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+
+ %% test_group_2 - auto_skip due to failed return from group/1
+ [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_2,[]}}},
+ {?eh,tc_done,
+ {skip_group_SUITE,{init_per_group,test_group_2,[]},
+ {auto_skipped,{group0_failed,bad_return_value}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_2},
+ {group0_failed,bad_return_value}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,4}}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_2},
+ {group0_failed,bad_return_value}}}],
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ %% test_group_3 - user_skip in init_per_group/2
+ [{?eh,tc_start,
+ {skip_group_SUITE,{init_per_group,test_group_3,[]}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [skip_group_SUITE,test_group_3,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [skip_group_SUITE,test_group_3,'$proplist',
+ {skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,tc_done,{skip_group_SUITE,
+ {init_per_group,test_group_3,[]},
+ {skipped,"Skipped in init_per_group/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,tc_user_skip,{skip_group_SUITE,
+ {test_case,test_group_3},
+ "Skipped in init_per_group/2"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,test_stats,{0,0,{3,4}}},
+ {?eh,tc_user_skip,{skip_group_SUITE,
+ {end_per_group,test_group_3},
+ "Skipped in init_per_group/2"}}],
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+
+ {?eh,tc_start,{skip_group_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ ok,[]]}},
+ {?eh,tc_done,{skip_group_SUITE,end_per_suite,ok}},
+
+
+ %% skip_case_SUITE has 4 test cases which are all skipped in
+ %% different ways
+ {?eh,tc_start,{skip_case_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ '_',
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,init_per_suite,ok}},
+
+ %% Skip in spec -> only on_tc_skip shall be called
+ {?eh,tc_user_skip,{skip_case_SUITE,skip_in_spec,"Skipped in spec"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_spec,
+ {tc_user_skip,"Skipped in spec"},
+ []]}},
+ {?eh,test_stats,{0,0,{4,4}}},
+
+ %% Skip in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,skip_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,skip_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,skip_in_init,
+ '$proplist',
+ {skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,skip_in_init,
+ {skipped,"Skipped in init_per_testcase/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_init,
+ {tc_user_skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,test_stats,{0,0,{5,4}}},
+
+ %% Fail in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,fail_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,fail_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,fail_in_init,
+ '$proplist',
+ {skip,{failed,'_'}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,fail_in_init,
+ {auto_skipped,{failed,'_'}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,fail_in_init,
+ {tc_auto_skip,{failed,'_'}},
+ []]}},
+ {?eh,test_stats,{0,0,{5,5}}},
+
+ %% Exit in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,exit_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,exit_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,exit_in_init,
+ '$proplist',
+ {skip,{failed,'_'}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,exit_in_init,
+ {auto_skipped,{failed,'_'}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,exit_in_init,
+ {tc_auto_skip,{failed,'_'}},
+ []]}},
+ {?eh,test_stats,{0,0,{5,6}}},
+
+ %% Fail in end_per_testcase -> all hooks shall be called and
+ %% test shall succeed.
+ {?eh,tc_start,{skip_case_SUITE,fail_in_end}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ ok,
+ []]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',
+ {test_case_failed,"Failed in end_per_testcase/2"}}}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,fail_in_end,
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',
+ {test_case_failed,"Failed in end_per_testcase/2"}}}}}},
+ {?eh,test_stats,{1,0,{5,6}}},
+
+ %% Exit in end_per_testcase -> all hooks shall be called and
+ %% test shall succeed.
+ {?eh,tc_start,{skip_case_SUITE,exit_in_end}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ ok,
+ []]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',"Exit in end_per_testcase/2"}}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,exit_in_end,
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',"Exit in end_per_testcase/2"}}}}},
+ {?eh,test_stats,{2,0,{5,6}}},
+
+ %% Skip in testcase function -> all callbacks shall be called
+ {?eh,tc_start,{skip_case_SUITE,skip_in_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ {skip,"Skipped in test case function"},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,skip_in_case,
+ {skipped,"Skipped in test case function"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_case,
+ {tc_user_skip,"Skipped in test case function"},
+ []]}},
+ {?eh,test_stats,{2,0,{6,6}}},
+
+ %% Auto skip due to failed 'require' -> only the on_tc_skip
+ %% callback shall be called
+ {?eh,tc_start,{skip_case_SUITE,req_auto_skip}},
+ {?eh,tc_done,{skip_case_SUITE,req_auto_skip,
+ {auto_skipped,{require_failed,{not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,req_auto_skip,
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{2,0,{6,7}}},
+
+ %% Auto skip due to failed testcase/0 function -> only the
+ %% on_tc_skip callback shall be called
+ {?eh,tc_start,{skip_case_SUITE,fail_auto_skip}},
+ {?eh,tc_done,{skip_case_SUITE,fail_auto_skip,
+ {auto_skipped,{testcase0_failed,bad_return_value}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,fail_auto_skip,
+ {tc_auto_skip,{testcase0_failed,bad_return_value}},
+ []]}},
+ {?eh,test_stats,{2,0,{6,8}}},
+
+ {?eh,tc_start,{skip_case_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ ok,[]]}},
+ {?eh,tc_done,{skip_case_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(failed_sequence) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[seq_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [seq_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{seq_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',
+ {error,failed_on_purpose},[]]}},
+ {?eh,tc_done,{seq_SUITE,test_case_1,{failed,{error,failed_on_purpose}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,
+ [seq_SUITE,test_case_1,failed_on_purpose,[]]}},
+ {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,tc_start,{seq_SUITE,test_case_2}},
+ {?eh,tc_done,{seq_SUITE,test_case_2,
+ {auto_skipped,{sequence_failed,seq1,test_case_1}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [seq_SUITE,test_case_2,
+ {tc_auto_skip,{sequence_failed,seq1,test_case_1}},
+ []]}},
+ {?eh,test_stats,{0,1,{0,1}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[seq_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,[seq_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(repeat_force_stop) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events=
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[repeat_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [repeat_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{repeat_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{repeat_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{repeat_SUITE,test_case_2}},
+ {?eh,tc_done,{repeat_SUITE,test_case_2,
+ {auto_skipped,
+ "Repeated test stopped by force_stop option"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [repeat_SUITE,test_case_2,
+ {tc_auto_skip,"Repeated test stopped by force_stop option"},
+ []]}},
+ {?eh,test_stats,{1,0,{0,1}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[repeat_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [repeat_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(config_clash) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [config_clash_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [config_clash_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{config_clash_SUITE,test_case_1}},
+ {?eh,tc_done,{config_clash_SUITE,test_case_1,
+ {failed,{error,{config_name_already_in_use,[aa]}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,
+ [config_clash_SUITE,test_case_1,
+ {config_name_already_in_use,[aa]},
+ []]}},
+ {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [config_clash_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [config_clash_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
test_events(ok) ->
ok.
-
%% test events help functions
contains(List) ->
fun(Proplist) when is_list(Proplist) ->
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl
new file mode 100644
index 0000000000..5b50548694
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl
@@ -0,0 +1,62 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(all_hook_callbacks_SUITE).
+
+-suite_defaults([{timetrap, {minutes, 10}}]).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include("ct.hrl").
+
+%% Test server callback functions
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(Config) ->
+ Config.
+
+end_per_group(_Config) ->
+ ok.
+
+init_per_testcase(skip_case, Config) ->
+ {skip,"Skipped in init_per_testcase/2"};
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [{group,test_group},test_case,skip_case].
+
+groups() ->
+ [{test_group,[test_case]}].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
+
+skip_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl
new file mode 100644
index 0000000000..f74c757cc1
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl
@@ -0,0 +1,43 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(config_clash_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [{require,aa,yy},{default_config,yy,"this is a default value"}].
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case_1].
+
+%% Test cases starts here.
+test_case_1() ->
+ [{require,aa,xx}].
+test_case_1(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl
new file mode 100644
index 0000000000..7cdaf2024b
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl
@@ -0,0 +1,51 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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_no_end_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that all pre/post_end_per_* callbacks
+%%% are called with correct SuiteName even if no end_per_* config
+%%% function exist in the suite, and that the non-exported config
+%%% functions fail with 'undef'.
+
+init_per_suite(Config) ->
+ Config.
+
+init_per_group(_Group,Config) ->
+ Config.
+
+init_per_testcase(_TC,Config) ->
+ Config.
+
+all() ->
+ [test_case_1, {group,test_group}].
+
+groups() ->
+ [{test_group,[],[test_case_2]}].
+
+test_case_1(Config) ->
+ ok.
+
+test_case_2(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl
new file mode 100644
index 0000000000..43c062d66f
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl
@@ -0,0 +1,54 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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_no_init_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that all
+%%% pre/post_init_per_group/testcase callbacks are called with correct
+%%% SuiteName even if no init_per_group/testcase function exist in the
+%%% suite, and that the non-exported config functions fail with 'undef'.
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+end_per_group(_Group,Config) ->
+ Config.
+
+end_per_testcase(_TC,Config) ->
+ Config.
+
+all() ->
+ [test_case_1, {group,test_group}].
+
+groups() ->
+ [{test_group,[],[test_case_2]}].
+
+test_case_1(Config) ->
+ ok.
+
+test_case_2(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl
new file mode 100644
index 0000000000..85dfe8ca4b
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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_no_init_suite_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that pre/post_init_per_suite
+%%% callbacks are called with correct SuiteName even if no
+%%% init_per_suite function exist in the suite, and that the
+%%% non-exported config function fails with 'undef'.
+
+end_per_suite(Config) ->
+ Config.
+
+all() ->
+ [test_case].
+
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
index c00eb5cf93..37742f0d20 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
@@ -44,18 +44,18 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
--export([pre_init_per_group/3]).
--export([post_init_per_group/4]).
--export([pre_end_per_group/3]).
--export([post_end_per_group/4]).
+-export([pre_init_per_group/4]).
+-export([post_init_per_group/5]).
+-export([pre_end_per_group/4]).
+-export([post_end_per_group/5]).
--export([pre_init_per_testcase/3]).
--export([post_init_per_testcase/4]).
--export([pre_end_per_testcase/3]).
--export([post_end_per_testcase/4]).
+-export([pre_init_per_testcase/4]).
+-export([post_init_per_testcase/5]).
+-export([pre_end_per_testcase/4]).
+-export([post_end_per_testcase/5]).
--export([on_tc_fail/3]).
--export([on_tc_skip/3]).
+-export([on_tc_fail/4]).
+-export([on_tc_skip/4]).
-export([terminate/1]).
@@ -154,150 +154,160 @@ post_end_per_suite(Suite,Config,Return,State) ->
%% @doc Called before each init_per_group.
%% You can change the config in this function.
--spec pre_init_per_group(Group :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_init_per_group(Suite :: atom(),
+ Group :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_init_per_group,
- [Group,Config,State]}}),
- ct:log("~w:pre_init_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,State]}}),
+ ct:log("~w:pre_init_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Config, State}.
%% @doc Called after each init_per_group.
%% You can change the return value in this function.
--spec post_init_per_group(Group :: atom(),
+-spec post_init_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config(),
Return :: config() | skip_or_fail(),
State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_init_per_group,
- [Group,Config,Return,State]}}),
- ct:log("~w:post_init_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,Return,State]}}),
+ ct:log("~w:post_init_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Return, State}.
%% @doc Called after each end_per_group. The config/state can be changed here,
%% though it will only affect the *end_per_group functions.
--spec pre_end_per_group(Group :: atom(),
+-spec pre_end_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config() | skip_or_fail(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_end_per_group,
- [Group,Config,State]}}),
- ct:log("~w:pre_end_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,State]}}),
+ ct:log("~w:pre_end_per_group(~w~w) called", [?MODULE,Suite,Group]),
{Config, State}.
%% @doc Called after each end_per_group. Note that the config cannot be
%% changed here, only the status of the group.
--spec post_end_per_group(Group :: atom(),
+-spec post_end_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config(),
Return :: term(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_end_per_group,
- [Group,Config,Return,State]}}),
- ct:log("~w:post_end_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,Return,State]}}),
+ ct:log("~w:post_end_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Return, State}.
%% @doc Called before init_per_testcase/2 for each test case.
%% You can change the config in this function.
--spec pre_init_per_testcase(TC :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_init_per_testcase(Suite :: atom(),
+ TC :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_init_per_testcase,
- [TC,Config,State]}}),
- ct:log("~w:pre_init_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,State]}}),
+ ct:log("~w:pre_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Config, State}.
%% @doc Called after init_per_testcase/2, and before the test case.
--spec post_init_per_testcase(TC :: atom(),
+-spec post_init_per_testcase(Suite :: atom(),
+ TC :: atom(),
Config :: config(),
Return :: config() | skip_or_fail(),
State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_testcase(TC,Config,Return,State) ->
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_init_per_testcase,
- [TC,Config,Return,State]}}),
- ct:log("~w:post_init_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,Return,State]}}),
+ ct:log("~w:post_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Return, State}.
%% @doc Called before end_per_testacse/2. No skip or fail allowed here,
%% only config additions.
--spec pre_end_per_testcase(TC :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_end_per_testcase(Suite :: atom(),
+ TC :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config(), NewState :: #state{}}.
-pre_end_per_testcase(TC,Config,State) ->
+pre_end_per_testcase(Suite,TC,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_end_per_testcase,
- [TC,Config,State]}}),
- ct:log("~w:pre_end_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,State]}}),
+ ct:log("~w:pre_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Config, State}.
%% @doc Called after end_per_testcase/2 for each test case. Note that
%% the config cannot be changed here, only the status of the test case.
--spec post_end_per_testcase(TC :: atom(),
+-spec post_end_per_testcase(Suite :: atom(),
+ TC :: atom(),
Config :: config(),
Return :: term(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_end_per_testcase,
- [TC,Config,Return,State]}}),
- ct:log("~w:post_end_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,Return,State]}}),
+ ct:log("~w:post_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Return, State}.
%% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group,
%% post_end_per_group and post_end_per_tc if the suite, group or test case failed.
%% This function should be used for extra cleanup which might be needed.
%% It is not possible to modify the config or the status of the test run.
--spec on_tc_fail(TC :: init_per_suite | end_per_suite |
+-spec on_tc_fail(Suite :: atom(),
+ TC :: init_per_suite | end_per_suite |
init_per_group | end_per_group | atom() |
{Function :: atom(), GroupName :: atom()},
Reason :: term(), State :: #state{}) -> NewState :: #state{}.
-on_tc_fail(TC, Reason, State) ->
+on_tc_fail(Suite, TC, Reason, State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, on_tc_fail,
- [TC,Reason,State]}}),
- ct:log("~w:on_tc_fail(~w) called", [?MODULE,TC]),
+ [Suite,TC,Reason,State]}}),
+ ct:log("~w:on_tc_fail(~w,~w) called", [?MODULE,Suite,TC]),
State.
%% @doc Called when a test case is skipped by either user action
%% or due to an init function failing. Test case can be
%% end_per_suite, init_per_group, end_per_group and the actual test cases.
--spec on_tc_skip(TC :: end_per_suite |
+-spec on_tc_skip(Suite :: atom(),
+ TC :: end_per_suite |
init_per_group | end_per_group | atom() |
{Function :: atom(), GroupName :: atom()},
{tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), Reason :: term()}}} |
{tc_user_skip, {skipped, Reason :: term()}},
State :: #state{}) -> NewState :: #state{}.
-on_tc_skip(TC, Reason, State) ->
+on_tc_skip(Suite, TC, Reason, State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, on_tc_skip,
- [TC,Reason,State]}}),
- ct:log("~w:on_tc_skip(~w) called", [?MODULE,TC]),
+ [Suite,TC,Reason,State]}}),
+ ct:log("~w:on_tc_skip(~w,~w) called", [?MODULE,Suite,TC]),
State.
%% @doc Called when the scope of the CTH is done, this depends on
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
index 559b22bc9f..141b933697 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
@@ -45,29 +45,29 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
index 51202443bf..07d7c84ed5 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
@@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl
new file mode 100644
index 0000000000..59a3d5cbf9
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl
@@ -0,0 +1,81 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(fallback_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+id(Opts) ->
+ empty_cth:id(Opts).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Group,Config,State) ->
+ empty_cth:pre_init_per_group(fallback_nosuite,Group,Config,State).
+
+post_init_per_group(Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(fallback_nosuite,Group,Config,Return,State).
+
+pre_end_per_group(Group,Config,State) ->
+ empty_cth:pre_end_per_group(fallback_nosuite,Group,Config,State).
+
+post_end_per_group(Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(fallback_nosuite,Group,Config,Return,State).
+
+pre_init_per_testcase(TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(fallback_nosuite,TC,Config,State).
+
+post_init_per_testcase(TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(fallback_nosuite,TC,Config,Return,State).
+
+pre_end_per_testcase(TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(fallback_nosuite,TC,Config,State).
+
+post_end_per_testcase(TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(fallback_nosuite,TC,Config,Return,State).
+
+on_tc_fail(TC, Reason, State) ->
+ empty_cth:on_tc_fail(fallback_nosuite,TC,Reason,State).
+
+on_tc_skip(TC, Reason, State) ->
+ empty_cth:on_tc_skip(fallback_nosuite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
index b49cbe7fb4..679f076f3a 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
@@ -29,13 +29,13 @@
%% CT Hooks
-export([init/2]).
-export([terminate/1]).
--export([on_tc_skip/3]).
+-export([on_tc_skip/4]).
init(Id, Opts) ->
empty_cth:init(Id, Opts).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite, TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
index a687743641..95bb76b4c1 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
@@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
index 4d9c60f1ca..3562d39967 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
@@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl
new file mode 100644
index 0000000000..fded4c02ab
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl
@@ -0,0 +1,42 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(repeat_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case_1, test_case_2].
+
+%% Test cases starts here.
+test_case_1(_Config) ->
+ timer:sleep(10000),
+ ok.
+
+test_case_2(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
index 494f398fc1..b9d9d4cec1 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
@@ -48,35 +48,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl
new file mode 100644
index 0000000000..6d1302fd35
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl
@@ -0,0 +1,45 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(seq_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [{sequence,seq1}].
+
+sequences() ->
+ [{seq1,[test_case_1,test_case_2]}].
+
+%% Test cases starts here.
+test_case_1(_Config) ->
+ exit(failed_on_purpose).
+
+test_case_2(_Config) ->
+ ct:fail("This test shall never be run since test_case_1 fails "
+ "and they are run in sequence").
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec
new file mode 100644
index 0000000000..a271c5e8b2
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec
@@ -0,0 +1,8 @@
+{suites,".",[all_hook_callbacks_SUITE,
+ skip_init_SUITE,
+ skip_req_SUITE,
+ skip_fail_SUITE,
+ skip_group_SUITE,
+ skip_case_SUITE]}.
+{skip_suites,".",all_hook_callbacks_SUITE,"Skipped in spec"}.
+{skip_cases,".",skip_case_SUITE,skip_in_spec,"Skipped in spec"}.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl
new file mode 100644
index 0000000000..dad80ae914
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_case_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(skip_in_init,Config) ->
+ {skip,"Skipped in init_per_testcase/2"};
+init_per_testcase(fail_in_init,Config) ->
+ ct:fail("Failed in init_per_testcase/2");
+init_per_testcase(exit_in_init,Config) ->
+ exit(self(),"Exit in init_per_testcase/2");
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(fail_in_end,_) ->
+ ct:fail("Failed in end_per_testcase/2");
+end_per_testcase(exit_in_end,_) ->
+ exit(self(),"Exit in end_per_testcase/2");
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [skip_in_spec,
+ skip_in_init,
+ fail_in_init,
+ exit_in_init,
+ fail_in_end,
+ exit_in_end,
+ skip_in_case,
+ req_auto_skip,
+ fail_auto_skip
+ ].
+
+%% Test cases starts here.
+skip_in_spec(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall be skipped in the test spec.").
+
+skip_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall be skipped in init_per_testcase/2.").
+
+fail_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall fail in init_per_testcase/2.").
+
+exit_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall exit in init_per_testcase/2.").
+
+fail_in_end(Config) ->
+ ok.
+
+exit_in_end(Config) ->
+ ok.
+
+skip_in_case(Config) ->
+ {skip,"Skipped in test case function"}.
+
+req_auto_skip() ->
+ [{require,whatever}].
+req_auto_skip(Config) ->
+ ct:fail("This test shall never be run due to "
+ "failed require").
+
+fail_auto_skip() ->
+ faulty_return_value.
+fail_auto_skip(Config) ->
+ ct:fail("This test shall never be run due to "
+ "faulty return from info function").
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl
new file mode 100644
index 0000000000..16f015fe7a
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl
@@ -0,0 +1,182 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+%% Send a cth_error event if a callback is called with unexpected arguments
+-define(fail(Info),
+ gen_event:notify(
+ ?CT_EVMGR_REF,
+ #event{ name = cth_error,
+ node = node(),
+ data = {illegal_hook_callback,{?MODULE,?FUNCTION_NAME,Info}}})).
+
+%% CT Hooks
+-compile(export_all).
+
+id(Opts) ->
+ empty_cth:id(Opts).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ Suite==skip_init_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==skip_case_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ Suite==skip_init_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==skip_case_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ Suite==skip_case_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ Suite==skip_case_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+ (Suite==skip_group_SUITE andalso Group==test_group_3)
+ orelse ?fail({Suite,Group}),
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ (Suite==skip_group_SUITE andalso Group==test_group_3)
+ orelse ?fail({Suite,Group}),
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+ ?fail({Suite,Group}),
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ ?fail({Suite,Group}),
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_init
+ orelse TC==fail_in_init
+ orelse TC==exit_in_init
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end
+ orelse TC==skip_in_case))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
+
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_init
+ orelse TC==fail_in_init
+ orelse TC==exit_in_init
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end
+ orelse TC==skip_in_case))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
+
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_case
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_case
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
+
+on_tc_fail(Suite,TC,Reason,State) ->
+ (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==config_clash_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(all_hook_callbacks_SUITE=Suite,all=TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State)
+ when (Suite==skip_init_SUITE
+ orelse Suite==skip_req_SUITE
+ orelse Suite==skip_fail_SUITE)
+ andalso
+ (TC==init_per_suite
+ orelse TC==test_case
+ orelse TC==end_per_suite) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(skip_group_SUITE=Suite,TC={C,G},Reason,State)
+ when (C==init_per_group orelse C==test_case orelse C==end_per_group) andalso
+ (G==test_group_1 orelse G==test_group_2 orelse G==test_group_3) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(skip_case_SUITE=Suite,TC,Reason,State)
+ when TC==skip_in_spec;
+ TC==skip_in_init;
+ TC==fail_in_init;
+ TC==exit_in_init;
+ TC==skip_in_case;
+ TC==req_auto_skip;
+ TC==fail_auto_skip ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State)
+ when (Suite==seq_SUITE andalso TC==test_case_2)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_2) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State) ->
+ ?fail({Suite,TC}),
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl
new file mode 100644
index 0000000000..9f5dfee6b9
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_fail_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ faulty_return_value.
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl
new file mode 100644
index 0000000000..d3b848bfbd
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl
@@ -0,0 +1,64 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_group_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+group(test_group_1) ->
+ [{require,whatever}];
+group(test_group_2) ->
+ faulty_return_value;
+group(_) ->
+ [].
+
+init_per_group(test_group_3,Config) ->
+ {skip,"Skipped in init_per_group/2"};
+init_per_group(_,Config) ->
+ ct:fail("This shall never be run due to auto_skip from group/1").
+
+end_per_group(_,_) ->
+ ct:fail("This shall never be run").
+
+all() ->
+ [{group,test_group_1},
+ {group,test_group_2},
+ {group,test_group_3}].
+
+groups() ->
+ [{test_group_1,[test_case]},
+ {test_group_2,[test_case]},
+ {test_group_3,[test_case]}].
+
+%% Test cases starts here.
+test_case(_Config) ->
+ ct:fail("This test case shall never be run due to skip on group level").
+
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl
new file mode 100644
index 0000000000..70305421ac
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_init_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ {skip,"Skipped in init_per_suite/1"}.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
index d5b347e723..48a2d70e22 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
@@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
index 36abac0bf8..d638954d3c 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
@@ -46,36 +46,36 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{{skip, "Test skip"}, State}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl
new file mode 100644
index 0000000000..e1d261d59a
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl
@@ -0,0 +1,79 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_pre_init_tc_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
+ {{skip, "Skipped in pre_init_per_testcase"}, State}.
+
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
+
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
+
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
index fa510b2d54..d7b07ee33c 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
@@ -46,35 +46,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl
new file mode 100644
index 0000000000..bc69dd5ea4
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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(skip_req_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [{require,whatever}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
index 7ec0d458b6..c6e0419c50 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
@@ -48,44 +48,44 @@ post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State),
{Return, [post_end_per_suite|State]}.
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State),
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State),
{Config, [pre_init_per_group|State]}.
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State),
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State),
{Return, [post_init_per_group|State]}.
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{Config, [pre_end_per_group|State]}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State),
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State),
{Return, [post_end_per_group|State]}.
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State),
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
{Config, [pre_init_per_testcase|State]}.
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State),
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State),
{Return, [post_init_per_testcase|State]}.
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State),
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State),
{Config, [pre_end_per_testcase|State]}.
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State),
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
{Return, [post_end_per_testcase|State]}.
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State),
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State),
[on_tc_fail|State].
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State),
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State),
[on_tc_skip|State].
terminate(State) ->
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
index 2b9e726819..10a7047899 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
@@ -44,35 +44,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
index d48981f667..f933c7702e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
@@ -50,43 +50,43 @@ post_end_per_suite(Suite,Config,Return,State) ->
NewConfig = [{post_end_per_suite,?now}|Config],
{NewConfig,NewConfig}.
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State),
+pre_init_per_group(Suite, Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State),
{[{pre_init_per_group,?now}|Config],State}.
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State),
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State),
{[{post_init_per_group,?now}|Return],State}.
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{[{pre_end_per_group,?now}|Config],State}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State),
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State),
{[{post_end_per_group,?now}|Config],State}.
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State),
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
{[{pre_init_per_testcase,?now}|Config],State}.
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State),
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State),
{[{post_init_per_testcase,?now}|Config],State}.
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State),
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State),
{[{pre_end_per_testcase,?now}|Config],State}.
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State),
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
{[{post_end_per_testcase,?now}|Config],State}.
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
index 71d84781e0..b29256a77e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
@@ -60,37 +60,37 @@ post_end_per_suite(Suite,Config,Return,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
true = ?val(post_init_per_suite, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:pre_init_per_group(Group,
+ empty_cth:pre_init_per_group(Suite,Group,
[{pre_init_per_group,true} | Config],
State).
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
true = ?val(pre_init_per_group, Return),
test_group = ct:get_config(group_cfg),
- empty_cth:post_init_per_group(Group,
+ empty_cth:post_init_per_group(Suite,Group,
Config,
[{post_init_per_group,true} | Return],
State).
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
true = ?val(post_init_per_group, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:pre_end_per_group(Group,
+ empty_cth:pre_end_per_group(Suite,Group,
[{pre_end_per_group,true} | Config],
State).
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
true = ?val(pre_end_per_group, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:post_end_per_group(Group,Config,Return,State).
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
true = ?val(post_init_per_suite, Config),
case ?val(name, ?val(tc_group_properties, Config)) of
undefined ->
@@ -102,19 +102,19 @@ pre_init_per_testcase(TC,Config,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"),
TC = ct:get_config(CfgKey),
- empty_cth:pre_init_per_testcase(TC,
+ empty_cth:pre_init_per_testcase(Suite,TC,
[{pre_init_per_testcase,true} | Config],
State).
%%! TODO: Verify Config also in post_init and pre_end!
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
true = ?val(post_init_per_suite, Config),
true = ?val(pre_init_per_testcase, Config),
case ?val(name, ?val(tc_group_properties, Config)) of
@@ -127,13 +127,13 @@ post_end_per_testcase(TC,Config,Return,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"),
TC = ct:get_config(CfgKey),
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
index 9abd2e5e83..42e086b96e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
@@ -62,43 +62,43 @@ post_end_per_suite(Suite,Config,Return,State) ->
check_dirs(State,Config),
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_init_per_group(Group,Config,State).
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
check_dirs(State,Return),
- empty_cth:post_init_per_group(Group,Config,Return,State).
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_end_per_group(Group,Config,State).
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_end_per_group(Group,Config,Return,State).
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_init_per_testcase(TC,Config,State).
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
+pre_end_per_testcase(Suite,TC,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_end_per_testcase(TC,Config,State).
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE.erl
index f8b6a379f6..76611a2db3 100644
--- a/lib/common_test/test/ct_repeat_testrun_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_testrun_SUITE.erl
@@ -363,14 +363,17 @@ skip_first_tc1(Suite) ->
{?eh,tc_start,{Suite,tc1}},
{?eh,tc_done,{Suite,tc1,ok}},
{?eh,test_stats,{'_',0,{0,0}}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,1}}},
+ {?eh,tc_start,{Suite,{init_per_group,g,[]}}},
{?eh,tc_done,{Suite,{init_per_group,g,[]},?skipped}},
{?eh,tc_auto_skip,{Suite,{tc1,g},?skip_reason}},
{?eh,test_stats,{'_',0,{0,2}}},
{?eh,tc_auto_skip,{Suite,{tc2,g},?skip_reason}},
{?eh,test_stats,{'_',0,{0,3}}},
{?eh,tc_auto_skip,{Suite,{end_per_group,g},?skip_reason}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,4}}},
{?eh,tc_start,{Suite,end_per_suite}},
@@ -390,10 +393,12 @@ skip_tc1_in_group(Suite) ->
{?eh,tc_start,{Suite,tc1}},
{?eh,tc_done,{Suite,tc1,ok}},
{?eh,test_stats,{'_',0,{0,0}}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,1}}},
{?eh,tc_start,{Suite,{end_per_group,g,[]}}},
{?eh,tc_done,{Suite,{end_per_group,g,[]},ok}}],
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,2}}},
{?eh,tc_start,{Suite,end_per_suite}},
diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl
index 42ec685c16..884217afc2 100644
--- a/lib/common_test/test/ct_surefire_SUITE.erl
+++ b/lib/common_test/test/ct_surefire_SUITE.erl
@@ -73,7 +73,9 @@ all() ->
relative_path,
url,
logdir,
- fail_pre_init_per_suite
+ fail_pre_init_per_suite,
+ skip_case_in_spec,
+ skip_suite_in_spec
].
%%--------------------------------------------------------------------
@@ -119,6 +121,18 @@ fail_pre_init_per_suite(Config) when is_list(Config) ->
run(fail_pre_init_per_suite,[fail_pre_init_per_suite,
{cth_surefire,[{path,Path}]}],Path,Config,[],Suites).
+skip_case_in_spec(Config) ->
+ DataDir = ?config(data_dir,Config),
+ Spec = filename:join(DataDir,"skip_one_case.spec"),
+ Path = "skip_case_in_spec.xml",
+ run_spec(skip_case_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec).
+
+skip_suite_in_spec(Config) ->
+ DataDir = ?config(data_dir,Config),
+ Spec = filename:join(DataDir,"skip_one_suite.spec"),
+ Path = "skip_suite_in_spec.xml",
+ run_spec(skip_suite_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec).
+
%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
@@ -129,8 +143,15 @@ run(Case,CTHs,Report,Config,ExtraOpts) ->
Suite = filename:join(DataDir, "surefire_SUITE"),
run(Case,CTHs,Report,Config,ExtraOpts,Suite).
run(Case,CTHs,Report,Config,ExtraOpts,Suite) ->
- {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts],
- Config),
+ Test = [{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts],
+ do_run(Case, Report, Test, Config).
+
+run_spec(Case,CTHs,Report,Config,Spec) ->
+ Test = [{spec,Spec},{ct_hooks,CTHs},{label,Case}],
+ do_run(Case, Report, Test, Config).
+
+do_run(Case, Report, Test, Config) ->
+ {Opts,ERPid} = setup(Test, Config),
ok = execute(Case, Opts, ERPid, Config),
LogDir =
case lists:keyfind(logdir,1,Opts) of
@@ -201,7 +222,10 @@ test_suite_events(pass_SUITE) ->
{?eh,test_stats,{1,0,{0,0}}},
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,tc_done,{ct_framework,end_per_suite,ok}}];
-test_suite_events(_) ->
+test_suite_events(skip_all_surefire_SUITE) ->
+ [{?eh,tc_user_skip,{skip_all_surefire_SUITE,all,"skipped in spec"}},
+ {?eh,test_stats,{0,0,{1,0}}}];
+test_suite_events(Test) ->
[{?eh,tc_start,{surefire_SUITE,init_per_suite}},
{?eh,tc_done,{surefire_SUITE,init_per_suite,ok}},
{?eh,tc_start,{surefire_SUITE,tc_ok}},
@@ -210,46 +234,55 @@ test_suite_events(_) ->
{?eh,tc_start,{surefire_SUITE,tc_fail}},
{?eh,tc_done,{surefire_SUITE,tc_fail,
{failed,{error,{test_case_failed,"this test should fail"}}}}},
- {?eh,test_stats,{1,1,{0,0}}},
- {?eh,tc_start,{surefire_SUITE,tc_skip}},
- {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}},
- {?eh,test_stats,{1,1,{1,0}}},
- {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
- {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
- {auto_skipped,{require_failed,'_'}}}},
- {?eh,test_stats,{1,1,{1,1}}},
- [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}},
- {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}},
- {?eh,tc_start,{surefire_SUITE,tc_ok}},
- {?eh,tc_done,{surefire_SUITE,tc_ok,ok}},
- {?eh,test_stats,{2,1,{1,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_fail}},
- {?eh,tc_done,{surefire_SUITE,tc_fail,
- {failed,{error,{test_case_failed,"this test should fail"}}}}},
- {?eh,test_stats,{2,2,{1,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_skip}},
- {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}},
- {?eh,test_stats,{2,2,{2,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
- {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
- {auto_skipped,{require_failed,'_'}}}},
- {?eh,test_stats,{2,2,{2,2}}},
- {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}},
- {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}],
- [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}},
- {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]},
- {failed,{error,all_cases_should_be_skipped}}}},
- {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail},
- {failed,
- {surefire_SUITE,init_per_group,
- {'EXIT',all_cases_should_be_skipped}}}}},
- {?eh,test_stats,{2,2,{2,3}}},
- {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail},
- {failed,
- {surefire_SUITE,init_per_group,
- {'EXIT',all_cases_should_be_skipped}}}}}],
- {?eh,tc_start,{surefire_SUITE,end_per_suite}},
- {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}].
+ {?eh,test_stats,{1,1,{0,0}}}] ++
+ tc_skip_events(Test,undefined) ++
+ [{?eh,test_stats,{1,1,{1,0}}},
+ {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
+ {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
+ {auto_skipped,{require_failed,'_'}}}},
+ {?eh,test_stats,{1,1,{1,1}}},
+ [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}},
+ {?eh,tc_start,{surefire_SUITE,tc_ok}},
+ {?eh,tc_done,{surefire_SUITE,tc_ok,ok}},
+ {?eh,test_stats,{2,1,{1,1}}},
+ {?eh,tc_start,{surefire_SUITE,tc_fail}},
+ {?eh,tc_done,{surefire_SUITE,tc_fail,
+ {failed,{error,{test_case_failed,"this test should fail"}}}}},
+ {?eh,test_stats,{2,2,{1,1}}}] ++
+ tc_skip_events(Test,g) ++
+ [{?eh,test_stats,{2,2,{2,1}}},
+ {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
+ {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
+ {auto_skipped,{require_failed,'_'}}}},
+ {?eh,test_stats,{2,2,{2,2}}},
+ {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}],
+ [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]},
+ {failed,{error,all_cases_should_be_skipped}}}},
+ {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail},
+ {failed,
+ {surefire_SUITE,init_per_group,
+ {'EXIT',all_cases_should_be_skipped}}}}},
+ {?eh,test_stats,{2,2,{2,3}}},
+ {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail},
+ {failed,
+ {surefire_SUITE,init_per_group,
+ {'EXIT',all_cases_should_be_skipped}}}}}],
+ {?eh,tc_start,{surefire_SUITE,end_per_suite}},
+ {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}].
+
+tc_skip_events(skip_case_in_spec,Group) ->
+ [{?eh,tc_user_skip,{surefire_SUITE,tc_skip_name(Group),"skipped in spec"}}];
+tc_skip_events(_Test,_Group) ->
+ [{?eh,tc_start,{surefire_SUITE,tc_skip}},
+ {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}].
+
+tc_skip_name(undefined) ->
+ tc_skip;
+tc_skip_name(Group) ->
+ {tc_skip,Group}.
test_events(fail_pre_init_per_suite) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
@@ -257,6 +290,10 @@ test_events(fail_pre_init_per_suite) ->
test_suite_events(pass_SUITE) ++
test_suite_events(fail_SUITE, {1,0,{0,1}}) ++
[{?eh,stop_logging,[]}];
+test_events(skip_suite_in_spec) ->
+ [{?eh,start_logging,'_'},{?eh,start_info,{1,1,0}}] ++
+ test_suite_events(skip_all_surefire_SUITE) ++
+ [{?eh,stop_logging,[]}];
test_events(Test) ->
[{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++
test_suite_events(Test) ++
@@ -364,6 +401,8 @@ failed_or_skipped([]) ->
events_to_result(E) ->
events_to_result(E, []).
+events_to_result([{?eh,tc_user_skip,{_Suite,all,_}}|E], Result) ->
+ events_to_result(E, [[[s]]|Result]);
events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) ->
{Suite,Rest} = events_to_result1(E),
events_to_result(Rest, [[[s]|Suite]|Result]);
@@ -382,7 +421,7 @@ events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) ->
events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) ->
{Suite,Rest} = events_to_result1(E),
{[result(R)|Suite],Rest};
-events_to_result1([{?eh,tc_auto_skip,_}|E]) ->
+events_to_result1([{?eh,Skip,_}|E]) when Skip==tc_auto_skip; Skip==tc_user_skip ->
{Suite,Rest} = events_to_result1(E),
{[[s]|Suite],Rest};
events_to_result1([_|E]) ->
diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec
new file mode 100644
index 0000000000..42df8a7d1a
--- /dev/null
+++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec
@@ -0,0 +1,2 @@
+{suites,".",surefire_SUITE}.
+{skip_cases,".",surefire_SUITE,tc_skip,"skipped in spec"}.
diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec
new file mode 100644
index 0000000000..57966328ab
--- /dev/null
+++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec
@@ -0,0 +1,2 @@
+{suites,".",[skip_all_surefire_SUITE]}.
+{skip_suites,".",skip_all_surefire_SUITE,"skipped in spec"}.
diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
index 228d900545..ea8a1a5662 100644
--- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl
+++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
@@ -161,6 +161,7 @@ test_events(ts_if_1) ->
{?eh,tc_start,{ts_if_1_SUITE,tc4}},
{?eh,tc_done,{ts_if_1_SUITE,tc4,{failed,{error,failed_on_purpose}}}},
{?eh,test_stats,{1,2,{0,1}}},
+ {?eh,tc_start,{ts_if_1_SUITE,tc5}},
{?eh,tc_done,{ts_if_1_SUITE,tc5,{auto_skipped,{sequence_failed,seq1,tc4}}}},
{?eh,test_stats,{1,2,{0,2}}},
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index e926abd885..05a452b99d 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -765,23 +765,23 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto- or user skipped
- (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize})
+ (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize})
when AutoOrUserSkip == tc_auto_skip;
AutoOrUserSkip == tc_user_skip ->
RemEvs1 =
lists:dropwhile(
fun({EH,#event{name=tc_auto_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G ->
case match_data(R, Reason) of
match -> false;
_ -> true
end;
({EH,#event{name=tc_user_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G ->
case match_data(R, Reason) of
match -> false;
_ -> true
@@ -1008,20 +1008,20 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto-or user skipped
- (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize})
+ (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize})
when AutoOrUserSkip == tc_auto_skip;
AutoOrUserSkip == tc_user_skip ->
RemEvs1 =
lists:dropwhile(
fun({EH,#event{name=tc_auto_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M, Reason == R ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R ->
false;
({EH,#event{name=tc_user_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M, Reason == R ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R ->
false;
({EH,#event{name=stop_logging,
node=EvNode,data=_}}) when
@@ -1264,10 +1264,10 @@ log_events1([E={_EH,tc_done,{_M,{end_per_group,_GrName,Props},_R}} | Evs], Dev,
io:format(Dev, "~s~p]},~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ")
end;
-log_events1([E={_EH,tc_auto_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) ->
+log_events1([E={_EH,tc_auto_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) ->
io:format(Dev, "~s~p],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
-log_events1([E={_EH,tc_user_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) ->
+log_events1([E={_EH,tc_user_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) ->
io:format(Dev, "~s~p],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
log_events1([E], Dev, Ind) ->
diff --git a/lib/common_test/test/ct_testspec_2_SUITE.erl b/lib/common_test/test/ct_testspec_2_SUITE.erl
index 1a941df185..1bab80942a 100644
--- a/lib/common_test/test/ct_testspec_2_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_2_SUITE.erl
@@ -220,7 +220,24 @@ basic_compatible_no_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,Run,Skip}]}] = Tests,
+ [{Alias1V,x_SUITE,all},
+ {Alias1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {Alias1V,z_SUITE,all},
+ {Alias2V,x_SUITE,all},
+ {Alias2V,y_SUITE,all}] = lists:sort(Run),
+ [{Alias1V,z_SUITE,"skipped"},
+ {Alias2V,x_SUITE,{g1,all},"skipped"},
+ {Alias2V,x_SUITE,{g2,all},"skipped"},
+ {Alias2V,y_SUITE,tc1,"skipped"},
+ {Alias2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip),
+
+ ok.
+
%%%-----------------------------------------------------------------
%%%
@@ -346,7 +363,25 @@ basic_compatible_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -439,7 +474,28 @@ no_merging(_Config) ->
[{y_SUITE,[{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[tc1,tc2]},
+ {TO1V,y_SUITE,[{g1,all},{g2,all}]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,x_SUITE,[{skipped,g1,all},{skipped,g2,all}]},
+ {TO2V,y_SUITE,all},
+ {TO2V,y_SUITE,[{skipped,tc1},{skipped,tc2}]}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -510,7 +566,25 @@ multiple_specs(_Config) ->
{y_SUITE,[all,{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,FileResult,FileResult).
+ verify_result(Verify,FileResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([[SpecFile1,SpecFile2]]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile1,SpecFile2],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 3ce37b98e9..611cdc71ae 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -669,7 +669,7 @@ module.beam: module.erl \
<fsummary>Compiles a list of forms.</fsummary>
<desc>
<p>Is the same as
- <c>forms(File, [verbose,report_errors,report_warnings])</c>.
+ <c>forms(Forms, [verbose,report_errors,report_warnings])</c>.
</p>
</desc>
</func>
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/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index c100fc8ee2..ffa51bcfae 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -61,7 +61,6 @@
#include <openssl/evp.h>
#include <openssl/hmac.h>
-
/* Helper macro to construct a OPENSSL_VERSION_NUMBER.
* See openssl/opensslv.h
*/
@@ -326,7 +325,7 @@ static ErlNifFunc nif_funcs[] = {
{"rsa_private_crypt", 4, rsa_private_crypt},
{"dh_generate_parameters_nif", 2, dh_generate_parameters_nif},
{"dh_check", 1, dh_check},
- {"dh_generate_key_nif", 3, dh_generate_key_nif},
+ {"dh_generate_key_nif", 4, dh_generate_key_nif},
{"dh_compute_key_nif", 3, dh_compute_key_nif},
{"srp_value_B_nif", 5, srp_value_B_nif},
{"srp_user_secret_nif", 7, srp_user_secret_nif},
@@ -2727,12 +2726,13 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
}
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (PrivKey, DHParams=[P,G], Mpint) */
+{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */
DH* dh_params;
int pub_len, prv_len;
unsigned char *pub_ptr, *prv_ptr;
ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail;
int mpint; /* 0 or 4 */
+ unsigned long len = 0;
dh_params = DH_new();
@@ -2743,11 +2743,21 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_
|| !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dh_params->g)
|| !enif_is_empty_list(env, tail)
- || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) {
+ || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)
+ || !enif_get_ulong(env, argv[3], &len) ) {
DH_free(dh_params);
return enif_make_badarg(env);
}
+ if (len) {
+ if (len < BN_num_bits(dh_params->p))
+ dh_params->length = len;
+ else {
+ DH_free(dh_params);
+ return enif_make_badarg(env);
+ }
+ }
+
if (DH_generate_key(dh_params)) {
pub_len = BN_num_bytes(dh_params->pub_key);
prv_len = BN_num_bytes(dh_params->priv_key);
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index eda0f7af51..b6a1371154 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -100,7 +100,7 @@
<code>dh_private() = key_value() </code>
- <code>dh_params() = [key_value()] = [P, G] </code>
+ <code>dh_params() = [key_value()] = [P, G] | [P, G, PrivateKeyBitLength]</code>
<code>ecdh_public() = key_value() </code>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index da8626e38a..deeb763145 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;
@@ -546,9 +547,15 @@ exor(Bin1, Bin2) ->
generate_key(Type, Params) ->
generate_key(Type, Params, undefined).
-generate_key(dh, DHParameters, PrivateKey) ->
+generate_key(dh, DHParameters0, PrivateKey) ->
+ {DHParameters, Len} =
+ case DHParameters0 of
+ [P,G,L] -> {[P,G], L};
+ [P,G] -> {[P,G], 0}
+ end,
dh_generate_key_nif(ensure_int_as_bin(PrivateKey),
- map_ensure_int_as_bin(DHParameters), 0);
+ map_ensure_int_as_bin(DHParameters),
+ 0, Len);
generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg)
when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) ->
@@ -1200,11 +1207,11 @@ dh_check([_Prime,_Gen]) -> ?nif_stub.
{binary(),binary()}.
dh_generate_key(DHParameters) ->
- dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4).
+ dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4, 0).
dh_generate_key(PrivateKey, DHParameters) ->
- dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4).
+ dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4, 0).
-dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub.
+dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub.
%% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()]
%% MyPrivKey, OthersPublicKey = mpint()
diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src
index 5b28f7ae86..f517c51ec1 100644
--- a/lib/dialyzer/src/dialyzer.app.src
+++ b/lib/dialyzer/src/dialyzer.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -48,5 +48,5 @@
{applications, [compiler, hipe, kernel, stdlib, wx]},
{env, []},
{runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.0",
- "kernel-5.0","hipe-3.15.1","erts-8.0",
+ "kernel-5.0","hipe-3.15.4","erts-8.0",
"compiler-7.0"]}]}.
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..83ce875280 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -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);
@@ -1351,8 +1351,6 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
{Msg, Force} =
case t_is_none(ArgType0) of
true ->
- PatString = format_patterns(Pats),
- PatTypes = [PatString, format_type(OrigArgType, State1)],
%% See if this is covered by an earlier clause or if it
%% simply cannot match
OrigArgTypes =
@@ -1360,14 +1358,24 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
true -> Any = t_any(), [Any || _ <- Pats];
false -> t_to_tlist(OrigArgType)
end,
+ PatString = format_patterns(Pats),
+ ArgTypeString = format_type(OrigArgType, State1),
+ BindResOrig =
+ bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1),
Tag =
- case bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1) of
+ case BindResOrig of
{error, bind, _, _, _} -> pattern_match;
{error, record, _, _, _} -> record_match;
{error, opaque, _, _, _} -> opaque_match;
{_, _} -> pattern_match_cov
end,
- {{Tag, PatTypes}, false};
+ PatTypes = case BindResOrig of
+ {error, opaque, _, _, OpaqueType} ->
+ [PatString, ArgTypeString,
+ format_type(OpaqueType, State1)];
+ _ -> [PatString, ArgTypeString]
+ end,
+ {{Tag, PatTypes}, false};
false ->
%% Try to find out if this is a default clause in a list
%% comprehension and supress this. A real Hack(tm)
@@ -3090,7 +3098,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 +3108,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 +3509,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 +3586,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..5ababa43dc 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.
@@ -226,12 +234,8 @@ contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) ->
get_default_plt() ->
case os:getenv("DIALYZER_PLT") of
false ->
- case os:getenv("HOME") of
- false ->
- plt_error("The HOME environment variable needs to be set " ++
- "so that Dialyzer knows where to find the default PLT");
- HomeDir -> filename:join(HomeDir, ".dialyzer_plt")
- end;
+ {ok,[[HomeDir]]} = init:get_argument(home),
+ filename:join(HomeDir, ".dialyzer_plt");
UserSpecPlt -> UserSpecPlt
end.
@@ -253,8 +257,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 +377,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 +518,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 +683,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..4d650592e2 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -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,15 @@ 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) ->
+ TmpState2 = state__new_constraint_context(TmpState1),
+ {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2),
+ traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState);
+traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) ->
AccState.
traverse(Tree, DefinedVars, State) ->
@@ -2106,6 +2106,12 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval,
end;
v2_solve_disj([], [], _I, _Map, V2State, UL, MapL, Eval, Uneval, Failed) ->
{ok, V2State, lists:reverse(Eval), UL, MapL, lists:reverse(Uneval), Failed};
+v2_solve_disj([every_i], Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) ->
+ NewIs = case Cs of
+ [] -> [];
+ _ -> [I, every_i]
+ end,
+ v2_solve_disj(NewIs, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed);
v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) ->
Uneval = [{I,C#constraint_list.id} ||
not is_failed_list(C, V2State)] ++ Uneval0,
@@ -2177,7 +2183,7 @@ v2_solve_conj([I|Is], [Cs|Tail], I, Map0, Conj, IsFlat, V2State0,
M = lists:keydelete(I, 1, vars_per_child(U, Masks)),
{V2State2, NewF0} = save_updated_vars_list(AllCs, M, V2State1),
{NewF, F} = lists:splitwith(fun(J) -> J < I end, NewF0),
- Is1 = lists:umerge(Is, F),
+ Is1 = umerge_mask(Is, F),
NewFs = [NewF|NewFs0],
v2_solve_conj(Is1, Tail, I+1, Map, Conj, IsFlat, V2State2,
[U|UL], NewFs, VarsUp, LastMap, LastFlags)
@@ -2199,6 +2205,14 @@ v2_solve_conj([], _Cs, _I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
v2_solve_conj(NewFlags, Cs, 1, Map, Conj, IsFlat, V2State,
[], [], [U|VarsUp], Map, NewFlags)
end;
+v2_solve_conj([every_i], Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
+ LastMap, LastFlags) ->
+ NewIs = case Cs of
+ [] -> [];
+ _ -> [I, every_i]
+ end,
+ v2_solve_conj(NewIs, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
+ LastMap, LastFlags);
v2_solve_conj(Is, [_|Tail], I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
LastMap, LastFlags) ->
v2_solve_conj(Is, Tail, I+1, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
@@ -2215,7 +2229,12 @@ report_detected_loop(_) ->
add_mask_to_flags(Flags, [Im|M], I, L) when I > Im ->
add_mask_to_flags(Flags, M, I, [Im|L]);
add_mask_to_flags(Flags, [_|M], _I, L) ->
- {lists:umerge(M, Flags), lists:reverse(L)}.
+ {umerge_mask(Flags, M), lists:reverse(L)}.
+
+umerge_mask([every_i]=Is, _F) ->
+ Is;
+umerge_mask(Is, F) ->
+ lists:umerge(Is, F).
get_mask(V, Masks) ->
case maps:find(V, Masks) of
@@ -2229,7 +2248,7 @@ get_flags(#v2_state{constr_data = ConData}=V2State0, C) ->
error ->
?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]),
V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)},
- {V2State, lists:seq(1, length(Cs))};
+ {V2State, [every_i]};
{ok, failed} ->
{V2State0, failed_list};
{ok, {Part,U}} when U =/= [] ->
@@ -2702,11 +2721,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] ->
@@ -2906,8 +2928,9 @@ state__get_rec_var(Fun, #state{fun_map = Map}) ->
maps:find(Fun, Map).
state__finalize(State) ->
- State1 = enumerate_constraints(State),
- order_fun_constraints(State1).
+ State1 = state__new_constraint_context(State),
+ State2 = enumerate_constraints(State1),
+ order_fun_constraints(State2).
%% ============================================================================
%%
@@ -2987,7 +3010,7 @@ find_constraint_deps([Type|Tail], Acc) ->
NewAcc = [[t_var_name(D) || D <- t_collect_vars(Type)]|Acc],
find_constraint_deps(Tail, NewAcc);
find_constraint_deps([], Acc) ->
- lists:flatten(Acc).
+ lists:append(Acc).
mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs ->
#constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps};
@@ -3095,8 +3118,8 @@ expand_to_conjunctions(#constraint_list{type = disj, list = List}) ->
List1 = [C || C <- List, is_simple_constraint(C)],
%% Just an assert.
[] = [C || #constraint{} = C <- List1],
- Expanded = lists:flatten([expand_to_conjunctions(C)
- || #constraint_list{} = C <- List]),
+ Expanded = lists:append([expand_to_conjunctions(C)
+ || #constraint_list{} = C <- List]),
ReturnList = Expanded ++ List1,
if length(ReturnList) > ?DISJ_NORM_FORM_LIMIT -> throw(too_many_disj);
true -> ReturnList
@@ -3121,8 +3144,10 @@ calculate_deps(List) ->
calculate_deps([H|Tail], Acc) ->
Deps = get_deps(H),
calculate_deps(Tail, [Deps|Acc]);
+calculate_deps([], []) -> [];
+calculate_deps([], [L]) -> L;
calculate_deps([], Acc) ->
- ordsets:from_list(lists:flatten(Acc)).
+ lists:umerge(Acc).
mk_conj_constraint_list(List) ->
mk_constraint_list(conj, List).
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/abstract_SUITE.erl b/lib/dialyzer/test/abstract_SUITE.erl
index 269db3e836..0e84dfab24 100644
--- a/lib/dialyzer/test/abstract_SUITE.erl
+++ b/lib/dialyzer/test/abstract_SUITE.erl
@@ -7,7 +7,7 @@
-include_lib("common_test/include/ct.hrl").
-include("dialyzer_test_constants.hrl").
--export([suite/0, all/0, init_per_suite/0, init_per_suite/1]).
+-export([suite/0, all/0, init_per_suite/0, init_per_suite/1, end_per_suite/1]).
-export([generated_case/1]).
suite() ->
@@ -24,6 +24,10 @@ init_per_suite(Config) ->
ok -> [{dialyzer_options, []}|Config]
end.
+end_per_suite(_Config) ->
+ %% This function is required since init_per_suite/1 exists.
+ ok.
+
generated_case(Config) when is_list(Config) ->
%% Equivalent to:
%%
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
index cb6a88786e..365b4798c5 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
@@ -1,2 +1,2 @@
{dialyzer_options, []}.
-{time_limit, 2}.
+{time_limit, 5}.
diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options
index 50991c9bc5..02425c33f2 100644
--- a/lib/dialyzer/test/map_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options
@@ -1 +1,2 @@
{dialyzer_options, []}.
+{time_limit, 30}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
index 06ed52043a..cb301ff6a1 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
@@ -1,2 +1,2 @@
{dialyzer_options, [{warnings, [no_unused, no_return]}]}.
-{time_limit, 20}.
+{time_limit, 40}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/weird b/lib/dialyzer/test/opaque_SUITE_data/results/weird
new file mode 100644
index 0000000000..d7f57cd152
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/weird
@@ -0,0 +1,6 @@
+
+weird_warning1.erl:15: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #b{q::queue:queue(_)}
+weird_warning2.erl:13: Matching of pattern <{'b', Queue}, Key, Value> tagged with a record name violates the declared type of <#a{d::dict:dict(_,_)},'my_key','my_value'>
+weird_warning3.erl:14: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') does not have a term of type #a{d::dict:dict(_,_)} | #b{q::queue:queue(_)} (with opaque subterms) as 1st argument
+weird_warning3.erl:16: The attempt to match a term of type #a{d::queue:queue(_)} against the pattern {'a', Dict} breaks the opacity of queue:queue(_)
+weird_warning3.erl:18: Matching of pattern {'b', Queue} tagged with a record name violates the declared type of #a{d::queue:queue(_)}
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl
new file mode 100644
index 0000000000..094138e72b
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl
@@ -0,0 +1,18 @@
+-module(weird_warning1).
+-export([public_func/0]).
+
+-record(a, {
+ d = dict:new() :: dict:dict()
+ }).
+
+-record(b, {
+ q = queue:new() :: queue:queue()
+ }).
+
+public_func() ->
+ add_element(#b{}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl
new file mode 100644
index 0000000000..4e4512157b
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl
@@ -0,0 +1,14 @@
+-module(weird_warning2).
+-export([public_func/0]).
+
+-record(a, {d = dict:new() :: dict:dict()}).
+
+-record(b, {q = queue:new() :: queue:queue()}).
+
+public_func() ->
+ add_element(#a{}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl
new file mode 100644
index 0000000000..b70ca645cb
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl
@@ -0,0 +1,19 @@
+-module(weird_warning3).
+-export([public_func/0]).
+
+-record(a, {
+ d = dict:new() :: dict:dict()
+ }).
+
+-record(b, {
+ q = queue:new() :: queue:queue()
+ }).
+
+public_func() ->
+ %% Notice that t_to_string() will create "#a{d::queue:queue(_)}".
+ add_element({a, queue:new()}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl
index 460d4e2240..fbfa979e1b 100644
--- a/lib/dialyzer/test/plt_SUITE.erl
+++ b/lib/dialyzer/test/plt_SUITE.erl
@@ -26,6 +26,8 @@ build_plt(Config) ->
end.
beam_tests(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "beam_tests.plt"),
Prog = <<"
-module(no_auto_import).
@@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) ->
">>,
Opts = [no_auto_import],
{ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts),
- [] = run_dialyzer(plt_build, [BeamFile], []),
+ [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]),
ok.
run_plt_check(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "run_plt_check.plt"),
Mod1 = <<"
-module(run_plt_check1).
">>,
@@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) ->
{ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []),
{ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []),
- [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []),
+ [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]),
Mod2B = <<"
-module(run_plt_check2).
@@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) ->
% callgraph warning as run_plt_check2:call/1 makes a call to unexported
% function run_plt_check1:call/1.
- [_] = run_dialyzer(plt_check, [], []),
+ [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]),
ok.
run_succ_typings(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "run_succ_typings.plt"),
Mod1A = <<"
-module(run_succ_typings1).
@@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) ->
">>,
{ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []),
- [] = run_dialyzer(plt_build, [BeamFile1], []),
+ [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]),
Mod1B = <<"
-module(run_succ_typings1).
@@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) ->
{ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []),
% contract types warning as run_succ_typings2:call/0 makes a call to
% run_succ_typings1:call/0, which returns a (not b) in the PLT.
- [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]),
+ [_] = run_dialyzer(succ_typings, [BeamFile2],
+ [{check_plt, false}, {init_plt, Plt}]),
% warning not returned as run_succ_typings1 is updated in the PLT.
- [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]),
+ [] = run_dialyzer(succ_typings, [BeamFile2],
+ [{check_plt, true}, {init_plt, Plt}]),
ok.
@@ -252,12 +260,9 @@ remove_plt(Config) ->
ok.
bad_dialyzer_attr(Config) ->
- PrivDir = ?config(priv_dir, Config),
-
Prog1 = <<"-module(dial).
-dialyzer({no_return, [undef/0]}).">>,
{ok, Beam1} = compile(Config, Prog1, dial, []),
- Plt = filename:join(PrivDir, "bad_attr.plt"),
{dialyzer_error,
"Analysis failed with error:\n"
"Could not scan the following file(s):\n"
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/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml
index f1e52b1889..426f6b88ca 100644
--- a/lib/erl_interface/doc/src/erl_call.xml
+++ b/lib/erl_interface/doc/src/erl_call.xml
@@ -193,7 +193,7 @@ erl_call -s -a 'erlang halt' -n madonna
<p>To apply with many arguments:</p>
<code type="none"><![CDATA[
-erl_call -s -a 'lists map [{math,sqrt},[1,4,9,16,25]]' -n madonna
+erl_call -s -a 'lists seq [1,10]' -n madonna
]]></code>
<p>To evaluate some expressions
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 226a5d0f61..a5a3e8c136 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()}.
@@ -524,7 +526,8 @@ list_contains_opaque(List, Opaques) ->
lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List).
%% t_find_opaque_mismatch/2 of two types should only be used if their
-%% t_inf is t_none() due to some opaque type violation.
+%% t_inf is t_none() due to some opaque type violation. However,
+%% 'error' is returned if a structure mismatch is found.
%%
%% The first argument of the function is the pattern and its second
%% argument the type we are matching against the pattern.
@@ -533,22 +536,30 @@ list_contains_opaque(List, Opaques) ->
'error' | {'ok', erl_type(), erl_type()}.
t_find_opaque_mismatch(T1, T2, Opaques) ->
- t_find_opaque_mismatch(T1, T2, T2, Opaques).
+ catch t_find_opaque_mismatch(T1, T2, T2, Opaques).
t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error;
-t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> error;
+t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error);
t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) ->
t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques);
t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) ->
case is_opaque_type(T2, Opaques) of
- false -> {ok, TopType, T2};
+ false ->
+ case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T2}
+ end;
true ->
t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques)
end;
t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) ->
%% The generated message is somewhat misleading:
case is_opaque_type(T1, Opaques) of
- false -> {ok, TopType, T1};
+ false ->
+ case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T1}
+ end;
true ->
t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques)
end;
@@ -564,7 +575,11 @@ t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2,
t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques);
t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) ->
t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques);
-t_find_opaque_mismatch(_T1, _T2, _TopType, _Opaques) -> error.
+t_find_opaque_mismatch(T1, T2, _TopType, Opaques) ->
+ case t_is_none(t_inf(T1, T2, Opaques)) of
+ false -> error;
+ true -> throw(error)
+ end.
t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) ->
List = lists:zipwith(fun(T1, T2) ->
@@ -573,10 +588,11 @@ t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) ->
t_find_opaque_mismatch_list(List).
t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) ->
- List = [t_find_opaque_mismatch(T1, T2, T2, Opaques) || T1 <- L1, T2 <- L2],
+ List = [catch t_find_opaque_mismatch(T1, T2, T2, Opaques) ||
+ T1 <- L1, T2 <- L2],
t_find_opaque_mismatch_list(List).
-t_find_opaque_mismatch_list([]) -> error;
+t_find_opaque_mismatch_list([]) -> throw(error);
t_find_opaque_mismatch_list([H|T]) ->
case H of
{ok, _T1, _T2} -> H;
@@ -749,16 +765,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 +783,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 +818,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.
%%
@@ -2245,16 +2257,21 @@ t_has_var_list([]) -> false.
-spec t_collect_vars(erl_type()) -> [erl_type()].
t_collect_vars(T) ->
- t_collect_vars(T, []).
+ Vs = t_collect_vars(T, maps:new()),
+ [V || {V, _} <- maps:to_list(Vs)].
--spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()].
+-type ctab() :: #{erl_type() => 'any'}.
+
+-spec t_collect_vars(erl_type(), ctab()) -> ctab().
t_collect_vars(?var(_) = Var, Acc) ->
- ordsets:add_element(Var, Acc);
+ maps:put(Var, any, Acc);
t_collect_vars(?function(Domain, Range), Acc) ->
- ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, []));
+ Acc1 = t_collect_vars(Domain, Acc),
+ t_collect_vars(Range, Acc1);
t_collect_vars(?list(Contents, Termination, _), Acc) ->
- ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, []));
+ Acc1 = t_collect_vars(Contents, Acc),
+ t_collect_vars(Termination, Acc1);
t_collect_vars(?product(Types), Acc) ->
t_collect_vars_list(Types, Acc);
t_collect_vars(?tuple(?any, ?any, ?any), Acc) ->
@@ -3052,6 +3069,9 @@ inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) ->
end
end.
+compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) ->
+ [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)].
+
is_compat_opaque_names(Opaque1, Opaque2) ->
#opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1,
#opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2,
@@ -3067,88 +3087,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 +4204,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 +4565,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 +5081,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 +5183,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 +5266,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 +5330,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 +5345,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 +5366,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/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 398fc7e5b6..5c3b5a2d3c 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,22 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.3.4</title>
+ <section><title>Inets 6.3.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Correct misstakes in ftp client introduced in inets-6.3.4</p>
+ <p>
+ Own Id: OTP-14203 Aux Id: OTP-13982 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.3.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl
index 911f5b71a7..23d6483291 100644
--- a/lib/inets/src/ftp/ftp.erl
+++ b/lib/inets/src/ftp/ftp.erl
@@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
caller = {recv_file, Fd}} = State)
when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- case file_close(Fd) of
- ok -> ok;
- {error,einval} -> ok
- end,
+ file_close(Fd),
progress_report({transfer_size, 0}, State),
activate_ctrl_connection(State),
{noreply, State#state{dsock = undefined, data = <<>>}};
@@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) ->
end;
handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) ->
- case file_close(Fd) of
- ok -> ok;
- {error, einval} -> ok
- end,
+ file_close(Fd),
close_data_connection(State),
ctrl_result_response(Status, State#state{dsock = undefined},
{error, epath});
@@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) ->
send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) ->
verbose(lists:flatten(Message),Verbose,send),
?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]),
- ok = send_message(Socket, Message).
+ _ = send_message(Socket, Message).
send_data_message(_S=#state{dsock = Socket}, Message) ->
?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]),
@@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) ->
send_message({ssl, Socket}, Message) ->
ssl:send(Socket, Message).
-activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) ->
- ok = activate_connection(Socket);
-activate_ctrl_connection(#state{csock = Socket}) ->
- ok = activate_connection(Socket),
+activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) ->
+ activate_connection(CSock);
+activate_ctrl_connection(#state{csock = CSock}) ->
+ activate_connection(CSock),
%% We have already received at least part of the next control message,
%% that has been saved in ctrl_data, process this first.
- self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>},
+ self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>},
ok.
+activate_data_connection(#state{dsock = DSock} = State) ->
+ activate_connection(DSock),
+ State.
+
+activate_connection(Socket) ->
+ ignore_return_value(
+ case socket_type(Socket) of
+ tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]);
+ ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}])
+ end).
+
+
+ignore_return_value(_) -> ok.
+
unwrap_socket({tcp,Socket}) -> Socket;
unwrap_socket({ssl,Socket}) -> Socket.
socket_type({tcp,_Socket}) -> tcp;
socket_type({ssl,_Socket}) -> ssl.
-activate_data_connection(#state{dsock = Socket} = State) ->
- ok = activate_connection(Socket),
- State.
-
-activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]);
-activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]).
-
close_ctrl_connection(#state{csock = undefined}) -> ok;
close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket).
close_data_connection(#state{dsock = undefined}) -> ok;
close_data_connection(#state{dsock = Socket}) -> close_connection(Socket).
-close_connection({lsock,Socket}) -> gen_tcp:close(Socket);
-close_connection({tcp, Socket}) -> gen_tcp:close(Socket);
-close_connection({ssl, Socket}) -> ssl:close(Socket).
+close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ).
%% ------------ FILE HANDLING ----------------------------------------
send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) ->
@@ -2408,7 +2409,7 @@ send_file(State, Fd) ->
progress_report({binary, Bin}, State),
send_file(State, Fd);
{ok, _, _} ->
- ok = file_close(Fd),
+ file_close(Fd),
close_data_connection(State),
progress_report({transfer_size, 0}, State),
activate_ctrl_connection(State),
@@ -2423,7 +2424,7 @@ file_open(File, Option) ->
file:open(File, [raw, binary, Option]).
file_close(Fd) ->
- file:close(Fd).
+ ignore_return_value( file:close(Fd) ).
file_read(Fd) ->
case file:read(Fd, ?FILE_BUFSIZE) of
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/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl
index 7e20a9ba67..82273c8c74 100644
--- a/lib/inets/src/http_server/httpd_request_handler.erl
+++ b/lib/inets/src/http_server/httpd_request_handler.erl
@@ -241,9 +241,9 @@ handle_info({tcp_closed, _}, State) ->
handle_info({ssl_closed, _}, State) ->
{stop, normal, State};
handle_info({tcp_error, _, _} = Reason, State) ->
- {stop, Reason, State};
+ {stop, {shutdown, Reason}, State};
handle_info({ssl_error, _, _} = Reason, State) ->
- {stop, Reason, State};
+ {stop, {shutdown, Reason}, State};
%% Timeouts
handle_info(timeout, #state{mfa = {_, parse, _}} = State) ->
diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src
index 3a31daeb20..d28d4cd766 100644
--- a/lib/inets/src/inets_app/inets.appup.src
+++ b/lib/inets/src/inets_app/inets.appup.src
@@ -18,10 +18,14 @@
%% %CopyrightEnd%
{"%VSN%",
[
+ {<<"6.2.4">>, [{load_module, httpd_request_handler,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
],
[
+ {<<"6.2.4">>, [{load_module, httpd_request_handler,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
]
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/inets/vsn.mk b/lib/inets/vsn.mk
index eef5abd610..9591ab22ed 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.3.4
+INETS_VSN = 6.3.5
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
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/error_logger.erl b/lib/kernel/src/error_logger.erl
index 3523f680a3..3ee8e2c6e6 100644
--- a/lib/kernel/src/error_logger.erl
+++ b/lib/kernel/src/error_logger.erl
@@ -360,8 +360,12 @@ init(Max) when is_integer(Max) ->
%% go back.
init({go_back, _PostState}) ->
{ok, {?buffer_size, 0, []}};
-init(_) -> %% Start and just relay to other
- {ok, []}. %% node if node(GLeader) =/= node().
+init(_) ->
+ %% The error logger process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ process_flag(message_queue_data, off_heap),
+ {ok, []}.
-spec handle_event(term(), state()) -> {'ok', state()}.
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 58b601e456..6d94f7770f 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -1413,7 +1413,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) ->
case open(FileName, Mode) of
{ok, Fd} ->
{ok, Fd, FileName};
- {error, enoent} ->
+ {error, Reason} when Reason =:= enoent; Reason =:= enotdir ->
path_open_first(Rest, Name, Mode, LastError);
Error ->
Error
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/kernel/src/os.erl b/lib/kernel/src/os.erl
index f8519d3a5e..03d4324992 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -289,12 +289,11 @@ get_data(Port, MonRef, Eot, Sofar) ->
more ->
get_data(Port, MonRef, Eot, [Sofar,Bytes]);
Last ->
- Port ! {self(), close},
- flush_until_closed(Port),
- flush_exit(Port),
+ catch port_close(Port),
+ flush_until_down(Port, MonRef),
iolist_to_binary([Sofar, Last])
end;
- {'DOWN', MonRef, _, _ , _} ->
+ {'DOWN', MonRef, _, _, _} ->
flush_exit(Port),
iolist_to_binary(Sofar)
end.
@@ -308,18 +307,25 @@ eot(Bs, Eot) ->
binary:part(Bs,{0, Pos})
end.
-flush_until_closed(Port) ->
+%% When port_close returns we know that all the
+%% messages sent have been sent and that the
+%% DOWN message is after them all.
+flush_until_down(Port, MonRef) ->
receive
{Port, {data, _Bytes}} ->
- flush_until_closed(Port);
- {Port, closed} ->
- true
+ flush_until_down(Port, MonRef);
+ {'DOWN', MonRef, _, _, _} ->
+ flush_exit(Port)
end.
+%% The exit signal is always delivered before
+%% the down signal, so we can be sure that if there
+%% was an exit message sent, it will be in the
+%% mailbox now.
flush_exit(Port) ->
receive
{'EXIT', Port, _} ->
ok
- after 1 -> % force context switch
+ after 0 ->
ok
end.
diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl
index 21bff02214..bd6ea26678 100644
--- a/lib/kernel/src/rpc.erl
+++ b/lib/kernel/src/rpc.erl
@@ -67,17 +67,27 @@
%%------------------------------------------------------------------------
+
+%% The rex server may receive a huge amount of
+%% messages. Make sure that they are stored off heap to
+%% avoid exessive GCs.
+
+-define(SPAWN_OPTS, [{spawn_opt,[{message_queue_data,off_heap}]}]).
+
%% Remote execution and broadcasting facility
-spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}.
start() ->
- gen_server:start({local,?NAME}, ?MODULE, [], []).
+ gen_server:start({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS).
-spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}.
start_link() ->
- gen_server:start_link({local,?NAME}, ?MODULE, [], []).
+ %% The rex server process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ gen_server:start_link({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS).
-spec stop() -> term().
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index c5167efa56..5777b397b8 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -588,20 +588,28 @@ sticky_compiler(Files, PrivDir) ->
[R || R <- Rets, R =/= ok].
do_sticky_compile(Mod, Dir) ->
- %% Make sure that the module is loaded. A module being sticky
- %% only prevents it from begin reloaded, not from being loaded
- %% from the wrong place to begin with.
- Mod = Mod:module_info(module),
- File = filename:append(Dir, atom_to_list(Mod)),
- Src = io_lib:format("-module(~s).\n"
- "-export([test/1]).\n"
- "test(me) -> fail.\n", [Mod]),
- ok = file:write_file(File++".erl", Src),
- case c:c(File, [{outdir,Dir}]) of
- {ok,Module} ->
- Module:test(me);
- {error,sticky_directory} ->
- ok
+ case code:is_sticky(Mod) of
+ true ->
+ %% Make sure that the module is loaded. A module being sticky
+ %% only prevents it from begin reloaded, not from being loaded
+ %% from the wrong place to begin with.
+ Mod = Mod:module_info(module),
+ File = filename:append(Dir, atom_to_list(Mod)),
+ Src = io_lib:format("-module(~s).\n"
+ "-export([test/1]).\n"
+ "test(me) -> fail.\n", [Mod]),
+ ok = file:write_file(File++".erl", Src),
+ case c:c(File, [{outdir,Dir}]) of
+ {ok,Module} ->
+ Module:test(me);
+ {error,sticky_directory} ->
+ ok
+ end;
+ false ->
+ %% For some reason the module is not sticky
+ %% could be that the .erlang file has
+ %% unstuck it?
+ {Mod, is_not_sticky}
end.
%% Test that the -pa and -pz options work as expected.
diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl
index b6e7551741..bb01c2384d 100644
--- a/lib/kernel/test/error_logger_SUITE.erl
+++ b/lib/kernel/test/error_logger_SUITE.erl
@@ -30,6 +30,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
+ off_heap/1,
error_report/1, info_report/1, error/1, info/1,
emulator/1, tty/1, logfile/1, add/1, delete/1]).
@@ -45,7 +46,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [error_report, info_report, error, info, emulator, tty,
+ [off_heap, error_report, info_report, error, info, emulator, tty,
logfile, add, delete].
groups() ->
@@ -66,6 +67,16 @@ end_per_group(_GroupName, Config) ->
%%-----------------------------------------------------------------
+off_heap(_Config) ->
+ %% The error_logger process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ MQD = message_queue_data,
+ {MQD,off_heap} = process_info(whereis(error_logger), MQD),
+ ok.
+
+%%-----------------------------------------------------------------
+
error_report(Config) when is_list(Config) ->
error_logger:add_report_handler(?MODULE, self()),
Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}],
diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl
index 1c72ddc87f..d76c4097d8 100644
--- a/lib/kernel/test/rpc_SUITE.erl
+++ b/lib/kernel/test/rpc_SUITE.erl
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
--export([call/1, block_call/1, multicall/1, multicall_timeout/1,
+-export([off_heap/1,
+ call/1, block_call/1, multicall/1, multicall_timeout/1,
multicall_dies/1, multicall_node_dies/1,
called_dies/1, called_node_dies/1,
called_throws/1, call_benchmark/1, async_call/1]).
@@ -35,7 +36,7 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- [call, block_call, multicall, multicall_timeout,
+ [off_heap, call, block_call, multicall, multicall_timeout,
multicall_dies, multicall_node_dies, called_dies,
called_node_dies, called_throws, call_benchmark,
async_call].
@@ -55,6 +56,13 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+off_heap(_Config) ->
+ %% The rex server process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ MQD = message_queue_data,
+ {MQD,off_heap} = process_info(whereis(rex), MQD),
+ ok.
%% Test different rpc calls.
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index 51c98d0d3e..9f59759cb6 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -39,7 +39,23 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.14.2</title>
+ <section><title>Mnesia 4.14.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed crash in checkpoint handling when table was deleted
+ during backup.</p>
+ <p>
+ Own Id: OTP-14167</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.14.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl
index 9eb939e8d3..fc626940b4 100644
--- a/lib/mnesia/src/mnesia_checkpoint.erl
+++ b/lib/mnesia/src/mnesia_checkpoint.erl
@@ -909,7 +909,7 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) ->
retainer_loop(Cp2);
{From, {iter_end, Iter}} ->
- retainer_fixtable(Iter#iter.oid_tab, false),
+ ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)),
Iters = Cp#checkpoint_args.iterators -- [Iter],
reply(From, Name, ok),
retainer_loop(Cp#checkpoint_args{iterators = Iters});
@@ -971,7 +971,8 @@ do_stop(Cp) ->
unset({checkpoint, Name}),
lists:foreach(fun deactivate_tab/1, Cp#checkpoint_args.retainers),
Iters = Cp#checkpoint_args.iterators,
- lists:foreach(fun(I) -> retainer_fixtable(I#iter.oid_tab, false) end, Iters).
+ [?SAFE(retainer_fixtable(Tab, false)) || #iter{main_tab=Tab} <- Iters],
+ ok.
deactivate_tab(R) ->
Name = R#retainer.cp_name,
@@ -1151,7 +1152,7 @@ do_change_copy(Cp, Tab, FromType, ToType) ->
Cp#checkpoint_args{retainers = Rs, nodes = writers(Rs)}.
check_iter(From, Iter) when Iter#iter.pid == From ->
- retainer_fixtable(Iter#iter.oid_tab, false),
+ ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)),
false;
check_iter(_From, _Iter) ->
true.
diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl
index 7320d381ea..6f7531245f 100644
--- a/lib/mnesia/src/mnesia_event.erl
+++ b/lib/mnesia/src/mnesia_event.erl
@@ -114,7 +114,8 @@ handle_table_event({Oper, Record, TransId}, State) ->
handle_system_event({mnesia_checkpoint_activated, _Checkpoint}, State) ->
{ok, State};
-handle_system_event({mnesia_checkpoint_deactivated, _Checkpoint}, State) ->
+handle_system_event({mnesia_checkpoint_deactivated, Checkpoint}, State) ->
+ report_error("Checkpoint '~p' has been deactivated, last table copy deleted.\n",[Checkpoint]),
{ok, State};
handle_system_event({mnesia_up, Node}, State) ->
diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl
index e745ec9b04..044cf501fd 100644
--- a/lib/mnesia/test/mnesia_evil_backup.erl
+++ b/lib/mnesia/test/mnesia_evil_backup.erl
@@ -723,18 +723,18 @@ bup_records(File, Mod) ->
exit(Reason)
end.
-sops_with_checkpoint(doc) ->
+sops_with_checkpoint(doc) ->
["Test schema operations during a checkpoint"];
sops_with_checkpoint(suite) -> [];
sops_with_checkpoint(Config) when is_list(Config) ->
- Ns = ?acquire_nodes(2, Config),
-
+ Ns = [N1,N2] = ?acquire_nodes(2, Config),
+
?match({ok, cp1, Ns}, mnesia:activate_checkpoint([{name, cp1},{max,mnesia:system_info(tables)}])),
- Tab = tab,
+ Tab = tab,
?match({atomic, ok}, mnesia:create_table(Tab, [{disc_copies,Ns}])),
OldRecs = [{Tab, K, -K} || K <- lists:seq(1, 5)],
[mnesia:dirty_write(R) || R <- OldRecs],
-
+
?match({ok, cp2, Ns}, mnesia:activate_checkpoint([{name, cp2},{max,mnesia:system_info(tables)}])),
File1 = "cp1_delete_me.BUP",
?match(ok, mnesia:dirty_write({Tab,6,-6})),
@@ -742,16 +742,16 @@ sops_with_checkpoint(Config) when is_list(Config) ->
?match(ok, mnesia:dirty_write({Tab,7,-7})),
File2 = "cp2_delete_me.BUP",
?match(ok, mnesia:backup_checkpoint(cp2, File2)),
-
+
?match(ok, mnesia:deactivate_checkpoint(cp1)),
?match(ok, mnesia:backup_checkpoint(cp2, File1)),
?match(ok, mnesia:dirty_write({Tab,8,-8})),
-
+
?match({atomic,ok}, mnesia:delete_table(Tab)),
?match({error,_}, mnesia:backup_checkpoint(cp2, File2)),
?match({'EXIT',_}, mnesia:dirty_write({Tab,9,-9})),
- ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])),
+ ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])),
Test = fun(N) when N > 5 -> ?error("To many records in backup ~p ~n", [N]);
(N) -> case mnesia:dirty_read(Tab,N) of
[{Tab,N,B}] when -B =:= N -> ok;
@@ -759,8 +759,29 @@ sops_with_checkpoint(Config) when is_list(Config) ->
end
end,
[Test(N) || N <- mnesia:dirty_all_keys(Tab)],
- ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])),
-
+ ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])),
+
+ %% Mnesia crashes when deleting a table during backup
+ ?match([], mnesia_test_lib:stop_mnesia([N2])),
+ Tab2 = ram,
+ ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies,[N1]}])),
+ ?match({ok, cp3, _}, mnesia:activate_checkpoint([{name, cp3},
+ {ram_overrides_dump,true},
+ {min,[Tab2]}])),
+ Write = fun Loop (N) ->
+ case N > 0 of
+ true ->
+ mnesia:dirty_write({Tab2, N+100, N+100}),
+ Loop(N-1);
+ false ->
+ ok
+ end
+ end,
+ ok = Write(100000),
+ spawn_link(fun() -> ?match({atomic, ok},mnesia:delete_table(Tab2)) end),
+
+ %% We don't check result here, depends on timing of above call
+ mnesia:backup_checkpoint(cp3, File2),
file:delete(File1), file:delete(File2),
- ?verify_mnesia(Ns, []).
+ ?verify_mnesia([N1], [N2]).
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index 439b21e58c..e272a469bb 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.14.2
+MNESIA_VSN = 4.14.3
diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl
index 0cea1fdcf0..200c728a62 100644
--- a/lib/observer/src/cdv_bin_cb.erl
+++ b/lib/observer/src/cdv_bin_cb.erl
@@ -58,7 +58,7 @@ binary_to_term_fun(Bin) ->
try binary_to_term(Bin) of
Term -> plain_html(io_lib:format("~p",[Term]))
catch error:badarg ->
- Warning = "This binary can not be coverted to an Erlang term",
+ Warning = "This binary can not be converted to an Erlang term",
observer_html_lib:warning(Warning)
end
end.
diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl
index 44f121f359..5782339183 100644
--- a/lib/observer/src/cdv_detail_wx.erl
+++ b/lib/observer/src/cdv_detail_wx.erl
@@ -55,7 +55,7 @@ init([Id, Data, ParentFrame, Callback, Parent]) ->
end,
{stop,normal};
{info,Info} ->
- observer_lib:display_info_dialog(Info),
+ observer_lib:display_info_dialog(ParentFrame,Info),
{stop,normal}
end.
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_app_wx.erl b/lib/observer/src/observer_app_wx.erl
index 936b2783e2..80a41fdde9 100644
--- a/lib/observer/src/observer_app_wx.erl
+++ b/lib/observer/src/observer_app_wx.erl
@@ -191,8 +191,8 @@ handle_event(#wx{event=#wxMouse{type=Type, x=X0, y=Y0}},
end;
handle_event(#wx{event=#wxCommand{type=command_menu_selected}},
- State = #state{sel=undefined}) ->
- observer_lib:display_info_dialog("Select process first"),
+ State = #state{panel=Panel,sel=undefined}) ->
+ observer_lib:display_info_dialog(Panel,"Select process first"),
{noreply, State};
handle_event(#wx{id=?ID_PROC_INFO, event=#wxCommand{type=command_menu_selected}},
@@ -205,7 +205,7 @@ handle_event(#wx{id=?ID_PROC_MSG, event=#wxCommand{type=command_menu_selected}},
case observer_lib:user_term(Panel, "Enter message", "") of
cancel -> ok;
{ok, Term} -> Pid ! Term;
- {error, Error} -> observer_lib:display_info_dialog(Error)
+ {error, Error} -> observer_lib:display_info_dialog(Panel,Error)
end,
{noreply, State};
@@ -214,7 +214,7 @@ handle_event(#wx{id=?ID_PROC_KILL, event=#wxCommand{type=command_menu_selected}}
case observer_lib:user_term(Panel, "Enter Exit Reason", "kill") of
cancel -> ok;
{ok, Term} -> exit(Pid, Term);
- {error, Error} -> observer_lib:display_info_dialog(Error)
+ {error, Error} -> observer_lib:display_info_dialog(Panel,Error)
end,
{noreply, State};
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 59a2f9f205..47844c1307 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -20,7 +20,7 @@
-module(observer_lib).
-export([get_wx_parent/1,
- display_info_dialog/1, display_yes_no_dialog/1,
+ display_info_dialog/2, display_yes_no_dialog/1,
display_progress_dialog/2, destroy_progress_dialog/0,
wait_for_progress/0, report_progress/1,
user_term/3, user_term_multiline/3,
@@ -105,10 +105,10 @@ setup_timer(Bool, {Timer, Old}) ->
timer:cancel(Timer),
setup_timer(Bool, {false, Old}).
-display_info_dialog(Str) ->
- display_info_dialog("",Str).
-display_info_dialog(Title,Str) ->
- Dlg = wxMessageDialog:new(wx:null(), Str, [{caption,Title}]),
+display_info_dialog(Parent,Str) ->
+ display_info_dialog(Parent,"",Str).
+display_info_dialog(Parent,Title,Str) ->
+ Dlg = wxMessageDialog:new(Parent, Str, [{caption,Title}]),
wxMessageDialog:showModal(Dlg),
wxMessageDialog:destroy(Dlg),
ok.
@@ -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
@@ -722,7 +724,7 @@ progress_loop(Title,PD,Caller) ->
if is_list(Reason) -> Reason;
true -> file:format_error(Reason)
end,
- display_info_dialog("Crashdump Viewer Error",FailMsg),
+ display_info_dialog(PD,"Crashdump Viewer Error",FailMsg),
Caller ! error,
unregister(?progress_handler),
unlink(Caller);
diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl
index 53ba3fa607..c21d2705c0 100644
--- a/lib/observer/src/observer_port_wx.erl
+++ b/lib/observer/src/observer_port_wx.erl
@@ -267,10 +267,19 @@ handle_cast(Event, _State) ->
error({unhandled_cast, Event}).
handle_info({portinfo_open, PortIdStr},
- State = #state{grid=Grid, ports=Ports, open_wins=Opened}) ->
- Port = lists:keyfind(PortIdStr,#port.id_str,Ports),
- NewOpened = display_port_info(Grid, Port, Opened),
- {noreply, State#state{open_wins = NewOpened}};
+ State = #state{node=Node, grid=Grid, opt=Opt, open_wins=Opened}) ->
+ Ports0 = get_ports(Node),
+ Ports = update_grid(Grid, Opt, Ports0),
+ Port = lists:keyfind(PortIdStr, #port.id_str, Ports),
+ NewOpened =
+ case Port of
+ false ->
+ self() ! {error,"No such port: " ++ PortIdStr},
+ Opened;
+ _ ->
+ display_port_info(Grid, Port, Opened)
+ end,
+ {noreply, State#state{ports=Ports, open_wins=NewOpened}};
handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt,
ports=OldPorts}) ->
@@ -296,8 +305,9 @@ handle_info(not_active, State = #state{timer = Timer0}) ->
Timer = observer_lib:stop_timer(Timer0),
{noreply, State#state{timer=Timer}};
-handle_info({error, Error}, State) ->
- handle_error(Error),
+handle_info({error, Error}, #state{panel=Panel} = State) ->
+ Str = io_lib:format("ERROR: ~s~n",[Error]),
+ observer_lib:display_info_dialog(Panel, Str),
{noreply, State};
handle_info(_Event, State) ->
@@ -501,11 +511,6 @@ filter_monitor_info() ->
[Pid || {process, Pid} <- Ms]
end.
-
-handle_error(Foo) ->
- Str = io_lib:format("ERROR: ~s~n",[Foo]),
- observer_lib:display_info_dialog(Str).
-
update_grid(Grid, Opt, Ports) ->
wx:batch(fun() -> update_grid2(Grid, Opt, Ports) end).
update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) ->
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/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index c13b164ff9..21eb9facc5 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -92,7 +92,7 @@ init([Pid, ParentFrame, Parent]) ->
observer_wx:return_to_localnode(ParentFrame, node(Pid)),
{stop, badrpc};
process_undefined ->
- observer_lib:display_info_dialog("No such alive process"),
+ observer_lib:display_info_dialog(ParentFrame,"No such alive process"),
{stop, normal}
end.
diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl
index 968a7620aa..4356cb890c 100644
--- a/lib/observer/src/observer_tv_wx.erl
+++ b/lib/observer/src/observer_tv_wx.erl
@@ -238,8 +238,9 @@ handle_info(not_active, State = #state{timer = Timer0}) ->
Timer = observer_lib:stop_timer(Timer0),
{noreply, State#state{timer=Timer}};
-handle_info({error, Error}, #state{opt=Opt}=State) ->
- handle_error(Error),
+handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) ->
+ Str = io_lib:format("ERROR: ~s~n",[Error]),
+ observer_lib:display_info_dialog(Panel,Str),
case Opt#opt.type of
mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true);
_ -> ok
@@ -365,10 +366,6 @@ list_to_strings([A]) -> integer_to_list(A);
list_to_strings([A|B]) ->
integer_to_list(A) ++ " ," ++ list_to_strings(B).
-handle_error(Foo) ->
- Str = io_lib:format("ERROR: ~s~n",[Foo]),
- observer_lib:display_info_dialog(Str).
-
update_grid(Grid, Opt, Tables) ->
wx:batch(fun() -> update_grid2(Grid, Opt, Tables) end).
update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) ->
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index 5732c12006..83de4fa64c 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -467,10 +467,10 @@ handle_info(_Info, State) ->
stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs,
trace_panel=Trace, app_panel=Apps, perf_panel=Perfs,
- allc_panel=Alloc} = _State) ->
+ allc_panel=Alloc, port_panel=Ports} = _State) ->
LogOn andalso rpc:block_call(Node, rb, stop, []),
Me = self(),
- Tabs = [Sys, Procs, TVs, Trace, Apps, Perfs, Alloc],
+ Tabs = [Sys, Procs, Ports, TVs, Trace, Apps, Perfs, Alloc],
Stop = fun() ->
try
_ = [wx_object:stop(Panel) || Panel <- Tabs],
@@ -580,9 +580,10 @@ get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys,
pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys,
tv_panel=Tv, trace_panel=Trace, app_panel=App,
- perf_panel=Perf, allc_panel=Alloc}) ->
+ perf_panel=Perf, allc_panel=Alloc, port_panel=Port}) ->
case Pid of
Pro -> "Processes";
+ Port -> "Ports";
Sys -> "System";
Tv -> "Table Viewer" ;
Trace -> ?TRACE_STR;
@@ -635,7 +636,8 @@ create_connect_dialog(connect, #state{frame = Frame}) ->
wxWindow:setSizerAndFit(Dialog, VSizer),
wxSizer:setSizeHints(VSizer, Dialog),
- CookiePath = filename:join(os:getenv("HOME"), ".erlang.cookie"),
+ {ok,[[HomeDir]]} = init:get_argument(home),
+ CookiePath = filename:join(HomeDir, ".erlang.cookie"),
DefaultCookie = case filelib:is_file(CookiePath) of
true ->
{ok, Bin} = file:read_file(CookiePath),
diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl
index 4c882ad951..b5fb027878 100644
--- a/lib/observer/test/observer_SUITE.erl
+++ b/lib/observer/test/observer_SUITE.erl
@@ -34,7 +34,8 @@
%% Test cases
-export([app_file/1, appup_file/1,
- basic/1, process_win/1, table_win/1
+ basic/1, process_win/1, table_win/1,
+ port_win_when_tab_not_initiated/1
]).
%% Default timetrap timeout (set in init_per_testcase)
@@ -49,7 +50,8 @@ groups() ->
[{gui, [],
[basic,
process_win,
- table_win
+ table_win,
+ port_win_when_tab_not_initiated
]
}].
@@ -299,6 +301,17 @@ table_win(Config) when is_list(Config) ->
observer:stop(),
ok.
+%% Test PR-1296/OTP-14151
+%% Clicking a link to a port before the port tab has been activated the
+%% first time crashes observer.
+port_win_when_tab_not_initiated(Config) ->
+ {ok,Port} = gen_tcp:listen(0,[]),
+ ok = observer:start(),
+ Notebook = setup_whitebox_testing(),
+ observer ! {open_link,erlang:port_to_list(Port)},
+ timer:sleep(1000),
+ observer:stop(),
+ ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl
index 4729d090f8..0a9a883390 100644
--- a/lib/os_mon/src/memsup.erl
+++ b/lib/os_mon/src/memsup.erl
@@ -701,6 +701,7 @@ get_os_wordsize_with_uname() ->
"sparc64" -> 64;
"amd64" -> 64;
"ppc64" -> 64;
+ "s390x" -> 64;
_ -> 32
end.
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index c503230d70..c97ec361d1 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -757,6 +757,39 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
</func>
<func>
+ <name>pkix_verify_hostname(Cert, ReferenceIDs) -> boolean()</name>
+ <name>pkix_verify_hostname(Cert, ReferenceIDs, Opts) -> boolean()</name>
+ <fsummary>Verifies that a PKIX x.509 certificate <i>presented identifier</i> (e.g hostname) is
+ an expected one.</fsummary>
+ <type>
+ <v>Cert = der_encoded() | #'OTPCertificate'{} </v>
+ <v>ReferenceIDs = [ RefID ]</v>
+ <v>RefID = {IdType,string()}</v>
+ <v>IdType = dns_id | srv_id | uri_id</v>
+ <v>Opts = [ PvhOpt() ]</v>
+ <v>PvhOpt = [MatchOpt | FailCallBackOpt | FqdnExtractOpt]</v>
+ <v>MatchOpt = {fun(RefId | FQDN::string(), PresentedID) -> boolean() | default}</v>
+ <v>PresentedID = {dNSName,string()} | {uniformResourceIdentifier,string()}</v>
+ <v>FailCallBackOpt = {fail_callback, fun(#'OTPCertificate'{}) -> boolean()}</v>
+ <v>FqdnExtractOpt = {fqdn_fun, fun(RefID) -> FQDN::string() | default | undefined}</v>
+ </type>
+ <desc>
+ <p>This function checks that the <i>Presented Identifier</i> (e.g hostname) in a peer certificate
+ conforms with the Expected Identifier that the client wants to connect to.
+ This functions is intended to be added as an extra client check to the peer certificate when performing
+ <seealso marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso>
+ </p>
+ <p>See <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>
+ for detailed information about hostname verification.
+ The <seealso marker="using_public_key#verify_hostname">User's Manual</seealso>
+ and
+ <seealso marker="using_public_key#verify_hostname_examples">code examples</seealso>
+ describes this function more detailed.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>sign(Msg, DigestType, Key) -> binary()</name>
<fsummary>Creates a digital signature.</fsummary>
<type>
@@ -824,6 +857,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>ssh_hostkey_fingerprint(HostKey) -> string()</name>
<name>ssh_hostkey_fingerprint(DigestType, HostKey) -> string()</name>
+ <name>ssh_hostkey_fingerprint([DigestType], HostKey) -> [string()]</name>
<fsummary>Calculates a ssh fingerprint for a hostkey.</fsummary>
<type>
<v>Key = public_key()</v>
@@ -847,6 +881,10 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
5> public_key:ssh_hostkey_fingerprint(sha256,Key).
"SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ"
+
+ 6> public_key:ssh_hostkey_fingerprint([sha,sha256],Key).
+ ["SHA1:bSLY/C4QXLDL/Iwmhyg0PGW9UbY",
+ "SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ"]
</code>
</desc>
</func>
diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml
index e3a1eed4be..417d479da3 100644
--- a/lib/public_key/doc/src/using_public_key.xml
+++ b/lib/public_key/doc/src/using_public_key.xml
@@ -417,6 +417,259 @@ true = public_key:verify(Digest, none, Signature, PublicKey),</code>
</section>
+ <section>
+ <marker id="verify_hostname"></marker>
+ <title>Verifying a certificate hostname</title>
+ <section>
+ <title>Background</title>
+ <p>When a client checks a server certificate there are a number of checks available like
+ checks that the certificate is not revoked, not forged or not out-of-date.
+ </p>
+ <p>There are however attacks that are not detected by those checks. Suppose a bad guy has
+ succeded with a DNS infection. Then the client could belive it is connecting to one host but
+ ends up at another but evil one. Though it is evil, it could have a perfectly legal
+ certificate! The certificate has a valid signature, it is not revoked, the certificate chain
+ is not faked and has a trusted root and so on.
+ </p>
+ <p>To detect that the server is not the intended one, the client must additionaly perform
+ a <i>hostname verification</i>. This procedure is described in
+ <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>. The idea is that the certificate
+ lists the hostnames it could be fetched from. This is checked by the certificate issuer when
+ the certificate is signed. So if the certificate is issued by a trusted root the client
+ could trust the host names signed in it.
+ </p>
+ <p>There is a default hostname matching procedure defined in
+ <url href="https://tools.ietf.org/html/rfc6125#section-6">RFC 6125, section 6</url>
+ as well as protocol dependent variations defined in
+ <url href="https://tools.ietf.org/html/rfc6125#appendix-B">RFC 6125 appendix B</url>.
+ The default procedure is implemented in
+ <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2,3</seealso>.
+ It is possible for a client to hook in modified rules using the options list.
+ </p>
+ <p>Some terminology is needed: the certificate presents hostname(s) on which it is valid.
+ Those are called <i>Presented IDs</i>. The hostname(s) the client belives it connects to
+ are called <i>Reference IDs</i>. The matching rules aims to verify that there is at least
+ one of the Reference IDs that matches one of the Presented IDs. If not, the verification fails.
+ </p>
+ <p>The IDs contains normal fully qualified domain names like e.g <c>foo.example.com</c>,
+ but IP addresses are not recommended. The rfc describes why this is not recommended as well
+ as security considerations about how to aquire the Reference IDs.
+ </p>
+ <p>Internationalized domain names are not supported.
+ </p>
+ </section>
+ <section>
+ <title>The verification process</title>
+ <p>Traditionally the Presented IDs were found in the <c>Subject</c> certificate field as <c>CN</c>
+ names. This is still quite common. When printing a certificate they show up as:
+ </p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org
+ ...
+ </code>
+ <p>The example <c>Subject</c> field has one C, two CN and one O part. It is only the
+ CN (Common Name) that is used by hostname verification. The two other (C and O) is not used
+ here even when they contain a domain name like the O part. The C and O parts are defined
+ elsewhere and meaningful only for other functions.
+ </p>
+ <p>In the example the Presented IDs are <c>example.com</c> as well as hostnames matching
+ <c>*.example.com</c>. For example <c>foo.example.com</c> and <c>bar.example.com</c> both
+ matches but not <c>foo.bar.example.com</c>. The name <c>erlang.org</c> matches neither
+ since it is not a CN.
+ </p>
+ <p>In case where the Presented IDs are fetched from the <c>Subject</c> certificate field, the
+ names may contain wildcard characters. The function handles this as defined in
+ <url href="https://tools.ietf.org/html/rfc6125#section-6.4.3">chapter 6.4.3 in RFC 6125</url>.
+ </p>
+ <p>There may only be one wildcard character and that is in the first label, for example:
+ <c>*.example.com</c>. This matches <c>foo.example.com</c> but neither <c>example.com</c> nor
+ <c>foo.bar.example.com</c>.
+ </p>
+ <p>There may be label characters before or/and after the wildcard. For example:
+ <c>a*d.example.com</c> matches <c>abcd.example.com</c> and <c>ad.example.com</c>,
+ but not <c>ab.cd.example.com</c>.
+ </p>
+ <p>In the previous example there is no indication of which protocols are expected. So a client
+ has no indication of whether it is a web server, an ldap server or maybe a sip server it is
+ connected to.
+ There are fields in the certificate that can indicate this. To be more exact, the rfc
+ introduces the usage of the <c>X509v3 Subject Alternative Name</c> in the <c>X509v3 extensions</c>
+ field:
+ </p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ X509v3 extensions:
+ X509v3 Subject Alternative Name:
+ DNS:kb.example.org, URI:https://www.example.org
+ ...
+ </code>
+ <p>Here <c>kb.example.org</c> serves any protocol while <c>www.example.org</c> presents a secure
+ web server.
+ </p>
+
+ <p>The next example has both <c>Subject</c> and <c>Subject Alternate Name</c> present:</p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org
+ ...
+ X509v3 extensions:
+ X509v3 Subject Alternative Name:
+ DNS:kb.example.org, URI:https://www.example.org
+ ...
+ </code>
+ <p>The RFC states that if a certificate defines Reference IDs in a <c>Subject Alternate Name</c>
+ field, the <c>Subject</c> field MUST NOT be used for host name checking, even if it contains
+ valid CN names.
+ Therefore only <c>kb.example.org</c> and <c>https://www.example.org</c> matches. The match fails
+ both for <c>example.com</c> and <c>foo.example.com</c> becuase they are in the <c>Subject</c>
+ field which is not checked because the <c>Subject Alternate Name</c> field is present.
+ </p>
+ </section>
+
+ <section>
+ <marker id="verify_hostname_examples"></marker>
+ <title>Function call examples</title>
+ <note>
+ <p>Other applications like ssl/tls or https might have options that are passed
+ down to the <c>public_key:pkix_verify_hostname</c>. You will probably not
+ have to call it directly</p>
+ </note>
+ <p>Suppose our client expects to connect to the web server https://www.example.net. This
+ URI is therefore the Reference IDs of the client.
+ The call will be:
+ </p>
+ <code>
+ public_key:pkix_verify_hostname(CertFromHost,
+ [{uri_id, "https://www.example.net"}
+ ]).
+ </code>
+ <p>The call will return <c>true</c> or <c>false</c> depending on the check. The caller
+ do not need to handle the matching rules in the rfc. The matching will proceed as:
+ </p>
+ <list>
+ <item>If there is a <c>Subject Alternate Name</c> field, the <c>{uri_id,string()}</c> in the
+ function call will be compared to any
+ <c>{uniformResourceIdentifier,string()}</c> in the Certificate field.
+ If the two <c>strings()</c> are equal (case insensitive), there is a match.
+ The same applies for any <c>{dns_id,string()}</c> in the call which is compared
+ with all <c>{dNSName,string()}</c> in the Certificate field.
+ </item>
+ <item>If there is NO <c>Subject Alternate Name</c> field, the <c>Subject</c> field will be
+ checked. All <c>CN</c> names will be compared to all hostnames <i>extracted</i> from
+ <c>{uri_id,string()}</c> and from <c>{dns_id,string()}</c>.
+ </item>
+ </list>
+ </section>
+ <section>
+ <title>Extending the search mechanism</title>
+ <p>The caller can use own extraction and matching rules. This is done with the two options
+ <c>fqdn_fun</c> and <c>match_fun</c>.
+ </p>
+ <section>
+ <title>Hostname extraction</title>
+ <p>The <c>fqdn_fun</c> extracts hostnames (Fully Qualified Domain Names) from uri_id
+ or other ReferenceIDs that are not pre-defined in the public_key function.
+ Suppose you have some URI with a very special protocol-part:
+ <c>myspecial://example.com"</c>. Since this a non-standard URI there will be no hostname
+ extracted for matching CN-names in the <c>Subject</c>.</p>
+ <p>To "teach" the function how to extract, you can give a fun which replaces the default
+ extraction function.
+ The <c>fqdn_fun</c> takes one argument and returns
+ either a <c>string()</c> to be matched to each CN-name or the atom <c>default</c> which will invoke
+ the default fqdn extraction function. The return value <c>undefined</c> removes the current
+ URI from the fqdn extraction.
+ </p>
+ <code>
+ ...
+ Extract = fun({uri_id, "myspecial://"++HostName}) -> HostName;
+ (_Else) -> default
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{fqdn_fun, Extract}])
+ ...
+ </code>
+ </section>
+ <section>
+ <title>Re-defining the match operations</title>
+ <p>The default matching handles dns_id and uri_id. In an uri_id the value is tested for
+ equality with a value from the <c>Subject Alternate Name</c>. If som other kind of matching
+ is needed, use the <c>match_fun</c> option.
+ </p>
+ <p>The <c>match_fun</c> takes two arguments and returns either <c>true</c>,
+ <c>false</c> or <c>default</c>. The value <c>default</c> will invoke the default
+ match function.
+ </p>
+ <code>
+ ...
+ Match = fun({uri_id,"myspecial://"++A},
+ {uniformResourceIdentifier,"myspecial://"++B}) ->
+ my_match(A,B);
+ (_RefID, _PresentedID) ->
+ default
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{match_fun, Match}]),
+ ...
+ </code>
+ <p>In case of a match operation between a ReferenceID and a CN value from the <c>Subject</c>
+ field, the first argument to the fun is the extracted hostname from the ReferenceID, and the
+ second argument is the tuple <c>{cn, string()}</c> taken from the <c>Subject</c> field. That
+ makes it possible to have separate matching rules for Presented IDs from the <c>Subject</c>
+ field and from the <c>Subject Alternate Name</c> field.
+ </p>
+ <p>The default matching transformes the ascii values in strings to lowercase before comparing.
+ The <c>match_fun</c> is however called without any transfomation applied to the strings. The
+ reason is to enable the user to do unforseen handling of the strings where the original format
+ is needed.
+ </p>
+ </section>
+ </section>
+ <section>
+ <title>"Pinning" a Certificate</title>
+ <p>The <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> defines <i>pinning</i>
+ as:</p>
+ <quote>
+ <p>"The act of establishing a cached name association between
+ the application service's certificate and one of the client's
+ reference identifiers, despite the fact that none of the presented
+ identifiers matches the given reference identifier. ..."
+ </p>
+ </quote>
+ <p>The purpose is to have a mechanism for a human to accept an otherwise faulty Certificate.
+ In for example a web browser, you could get a question like </p>
+ <quote>
+ <p>Warning: you wanted to visit the site www.example.com,
+ but the certificate is for shop.example.com. Accept anyway (yes/no)?"
+ </p>
+ </quote>
+ <p>This could be accomplished with the option <c>fail_callback</c> which will
+ be called if the hostname verification fails:
+ </p>
+ <code>
+ -include_lib("public_key/include/public_key.hrl"). % Record def
+ ...
+ Fail = fun(#'OTPCertificate'{}=C) ->
+ case in_my_cache(C) orelse my_accept(C) of
+ true ->
+ enter_my_cache(C),
+ true;
+ false ->
+ false
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{fail_callback, Fail}]),
+ ...
+ </code>
+ </section>
+ </section>
+
<section>
<title>SSH Files</title>
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 05c09f8996..adc35073d6 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -48,6 +48,7 @@
pkix_issuer_id/2,
pkix_normalize_name/1,
pkix_path_validation/3,
+ pkix_verify_hostname/2, pkix_verify_hostname/3,
ssh_decode/2, ssh_encode/2,
ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2,
ssh_curvename2oid/1, oid2ssh_curvename/1,
@@ -763,6 +764,76 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) ->
pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs,
Options, pubkey_crl:init_revokation_state()).
+%--------------------------------------------------------------------
+-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
+ ReferenceIDs :: [{uri_id | dns_id | oid(), string()}]) -> boolean().
+
+-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
+ ReferenceIDs :: [{uri_id | dns_id | oid(), string()}],
+ Options :: proplists:proplist()) -> boolean().
+
+%% Description: Validates a hostname to RFC 6125
+%%--------------------------------------------------------------------
+pkix_verify_hostname(Cert, ReferenceIDs) ->
+ pkix_verify_hostname(Cert, ReferenceIDs, []).
+
+pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) ->
+ pkix_verify_hostname(pkix_decode_cert(BinCert,otp), ReferenceIDs, Options);
+
+pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) ->
+ MatchFun = proplists:get_value(match_fun, Opts, undefined),
+ FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end),
+ FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1),
+
+ ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0],
+ PresentedIDs =
+ try lists:keyfind(?'id-ce-subjectAltName',
+ #'Extension'.extnID,
+ TbsCert#'OTPTBSCertificate'.extensions)
+ of
+ #'Extension'{extnValue = ExtVals} ->
+ [{T,to_string(V)} || {T,V} <- ExtVals];
+ false ->
+ []
+ catch
+ _:_ -> []
+ end,
+ %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]}
+ case PresentedIDs of
+ [] ->
+ %% Fallback to CN-ids [rfc6125, ch6]
+ case TbsCert#'OTPTBSCertificate'.subject of
+ {rdnSequence,RDNseq} ->
+ PresentedCNs =
+ [{cn, to_string(V)}
+ || ATVs <- RDNseq, % RDNseq is list-of-lists
+ #'AttributeTypeAndValue'{type = ?'id-at-commonName',
+ value = {_T,V}} <- ATVs
+ % _T = kind of string (teletexString etc)
+ ],
+ %% Example of PresentedCNs: [{cn,"www.ericsson.se"}]
+ %% match ReferenceIDs to PresentedCNs
+ verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun),
+ PresentedCNs,
+ MatchFun, FailCB, Cert);
+
+ _ ->
+ false
+ end;
+ _ ->
+ %% match ReferenceIDs to PresentedIDs
+ case verify_hostname_match_loop(ReferenceIDs, PresentedIDs,
+ MatchFun, FailCB, Cert) of
+ false ->
+ %% Try to extract DNS-IDs from URIs etc
+ DNS_ReferenceIDs =
+ [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)],
+ verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs,
+ MatchFun, FailCB, Cert);
+ true ->
+ true
+ end
+ end.
%%--------------------------------------------------------------------
-spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}]
@@ -822,21 +893,31 @@ oid2ssh_curvename(?'secp521r1') -> <<"nistp521">>.
%%--------------------------------------------------------------------
-spec ssh_hostkey_fingerprint(public_key()) -> string().
--spec ssh_hostkey_fingerprint(digest_type(), public_key()) -> string().
+-spec ssh_hostkey_fingerprint( digest_type(), public_key()) -> string()
+ ; ([digest_type()], public_key()) -> [string()]
+ .
ssh_hostkey_fingerprint(Key) ->
- sshfp_string(md5, Key).
+ sshfp_string(md5, public_key:ssh_encode(Key,ssh2_pubkey) ).
-ssh_hostkey_fingerprint(HashAlg, Key) ->
- lists:concat([sshfp_alg_name(HashAlg),
- [$: | sshfp_string(HashAlg, Key)]
- ]).
+ssh_hostkey_fingerprint(HashAlgs, Key) when is_list(HashAlgs) ->
+ EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
+ [sshfp_full_string(HashAlg,EncKey) || HashAlg <- HashAlgs];
+ssh_hostkey_fingerprint(HashAlg, Key) when is_atom(HashAlg) ->
+ EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
+ sshfp_full_string(HashAlg, EncKey).
-sshfp_string(HashAlg, Key) ->
+
+sshfp_string(HashAlg, EncodedKey) ->
%% Other HashAlgs than md5 will be printed with
%% other formats than hextstr by
%% ssh-keygen -E <alg> -lf <file>
- fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, public_key:ssh_encode(Key,ssh2_pubkey))).
+ fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, EncodedKey)).
+
+sshfp_full_string(HashAlg, EncKey) ->
+ lists:concat([sshfp_alg_name(HashAlg),
+ [$: | sshfp_string(HashAlg, EncKey)]
+ ]).
sshfp_alg_name(sha) -> "SHA1";
sshfp_alg_name(Alg) -> string:to_upper(atom_to_list(Alg)).
@@ -1200,3 +1281,96 @@ ascii_to_lower(String) ->
end)>>
||
<<C>> <= iolist_to_binary(String) >>.
+
+%%%----------------------------------------------------------------
+%%% pkix_verify_hostname help functions
+verify_hostname_extract_fqdn_default({dns_id,S}) ->
+ S;
+verify_hostname_extract_fqdn_default({uri_id,URI}) ->
+ {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI),
+ Host.
+
+
+verify_hostname_fqnds(L, FqdnFun) ->
+ [E || E0 <- L,
+ E <- [try case FqdnFun(E0) of
+ default -> verify_hostname_extract_fqdn_default(E0);
+ undefined -> undefined; % will make the "is_list(E)" test fail
+ Other -> Other
+ end
+ catch _:_-> undefined % will make the "is_list(E)" test fail
+ end],
+ is_list(E),
+ E =/= "",
+ {error,einval} == inet:parse_address(E)
+ ].
+
+
+-define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}).
+
+verify_hostname_match_default(Ref, Pres) ->
+ verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)).
+
+verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) ->
+ not lists:member($*, FQDN);
+verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) ->
+ [F1|Fs] = string:tokens(FQDN, "."),
+ [N1|Ns] = string:tokens(Name, "."),
+ match_wild(F1,N1) andalso Fs==Ns;
+verify_hostname_match_default0({dns_id,R}, {dNSName,P}) ->
+ R==P;
+verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) ->
+ R==P;
+verify_hostname_match_default0({srv_id,R}, {T,P}) when T == srvName ;
+ T == ?srvName_OID ->
+ R==P;
+verify_hostname_match_default0(_, _) ->
+ false.
+
+
+match_wild(A, [$*|B]) -> match_wild_suffixes(A, B);
+match_wild([C|A], [ C|B]) -> match_wild(A, B);
+match_wild([], []) -> true;
+match_wild(_, _) -> false.
+
+%% Match the parts after the only wildcard by comparing them from the end
+match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)).
+
+match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards alowed)
+match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards alowed)
+match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br);
+match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards)
+match_wild_sfx(_, _) -> false.
+
+
+verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) ->
+ Pres = lists:map(fun to_lower_ascii/1, Pres0),
+ Refs = lists:map(fun to_lower_ascii/1, Refs0),
+ lists:any(
+ fun(R) ->
+ lists:any(fun(P) ->
+ verify_hostname_match_default(R,P) orelse FailCB(Cert)
+ end, Pres)
+ end, Refs);
+verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) ->
+ lists:any(
+ fun(R) ->
+ lists:any(fun(P) ->
+ (case MatchFun(R,P) of
+ default -> verify_hostname_match_default(R,P);
+ Bool -> Bool
+ end) orelse FailCB(Cert)
+ end,
+ Pres)
+ end,
+ Refs).
+
+
+to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S);
+to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)};
+to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A);
+to_lower_ascii(C) -> C.
+
+to_string(S) when is_list(S) -> S;
+to_string(B) when is_binary(B) -> binary_to_list(B).
+
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index cd24819899..68aa152911 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -45,13 +45,17 @@ all() ->
{group, sign_verify},
pkix, pkix_countryname, pkix_emailaddress, pkix_path_validation,
pkix_iso_rsa_oid, pkix_iso_dsa_oid, pkix_crl, general_name,
+ pkix_verify_hostname_cn,
+ pkix_verify_hostname_subjAltName,
+ pkix_verify_hostname_options,
short_cert_issuer_hash, short_crl_issuer_hash,
ssh_hostkey_fingerprint_md5_implicit,
ssh_hostkey_fingerprint_md5,
ssh_hostkey_fingerprint_sha,
ssh_hostkey_fingerprint_sha256,
ssh_hostkey_fingerprint_sha384,
- ssh_hostkey_fingerprint_sha512
+ ssh_hostkey_fingerprint_sha512,
+ ssh_hostkey_fingerprint_list
].
groups() ->
@@ -90,20 +94,21 @@ end_per_group(_GroupName, Config) ->
%%-------------------------------------------------------------------
init_per_testcase(TestCase, Config) ->
case TestCase of
- ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase(md5, Config);
- ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase(md5, Config);
- ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase(sha, Config);
- ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase(sha256, Config);
- ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase(sha384, Config);
- ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase(sha512, Config);
+ ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase([md5], Config);
+ ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase([md5], Config);
+ ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase([sha], Config);
+ ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase([sha256], Config);
+ ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase([sha384], Config);
+ ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase([sha512], Config);
+ ssh_hostkey_fingerprint_list -> init_fingerprint_testcase([sha,md5], Config);
_ -> init_common_per_testcase(Config)
end.
-init_fingerprint_testcase(Alg, Config) ->
- CryptoSupports = lists:member(Alg, proplists:get_value(hashs, crypto:supports())),
- case CryptoSupports of
- false -> {skip,{Alg,not_supported}};
- true -> init_common_per_testcase(Config)
+init_fingerprint_testcase(Algs, Config) ->
+ Hashs = proplists:get_value(hashs, crypto:supports(), []),
+ case Algs -- Hashs of
+ [] -> init_common_per_testcase(Config);
+ UnsupportedAlgs -> {skip,{UnsupportedAlgs,not_supported}}
end.
init_common_per_testcase(Config0) ->
@@ -597,6 +602,14 @@ ssh_hostkey_fingerprint_sha512(_Config) ->
Expected = public_key:ssh_hostkey_fingerprint(sha512, ssh_hostkey(rsa)).
%%--------------------------------------------------------------------
+%% Since this kind of fingerprint is not available yet on standard
+%% distros, we do like this instead.
+ssh_hostkey_fingerprint_list(_Config) ->
+ Expected = ["SHA1:Soammnaqg06jrm2jivMSnzQGlmk",
+ "MD5:4b:0b:63:de:0f:a7:3a:ab:2c:cc:2d:d1:21:37:1d:3a"],
+ Expected = public_key:ssh_hostkey_fingerprint([sha,md5], ssh_hostkey(rsa)).
+
+%%--------------------------------------------------------------------
encrypt_decrypt() ->
[{doc, "Test public_key:encrypt_private and public_key:decrypt_public"}].
encrypt_decrypt(Config) when is_list(Config) ->
@@ -814,6 +827,114 @@ pkix_path_validation(Config) when is_list(Config) ->
ok.
%%--------------------------------------------------------------------
+%% To generate the PEM file contents:
+%%
+%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -subj '/C=SE/CN=example.com/CN=*.foo.example.com/CN=a*b.bar.example.com/O=erlang.org' > public_key_SUITE_data/pkix_verify_hostname_cn.pem
+%%
+%% Note that the same pem-file is used in pkix_verify_hostname_options/1
+%%
+%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org
+%% extensions = no subjAltName
+
+pkix_verify_hostname_cn(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that 1) only CNs are checked,
+ %% 2) an empty label does not match a wildcard and
+ %% 3) a wildcard does not match more than one label
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"},
+ {dns_id,"foo.EXAMPLE.com"},
+ {dns_id,"b.a.foo.EXAMPLE.com"}]),
+
+ %% Check that a hostname is extracted from a https-uri and used for checking:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"HTTPS://EXAMPLE.com"}]),
+
+ %% Check wildcard matching one label:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"a.foo.EXAMPLE.com"}]),
+
+ %% Check wildcard with surrounding chars matches one label:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"accb.bar.EXAMPLE.com"}]),
+
+ %% Check that a wildcard with surrounding chars matches an empty string:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://ab.bar.EXAMPLE.com"}]).
+
+%%--------------------------------------------------------------------
+%% To generate the PEM file contents:
+%%
+%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -extensions SAN -config public_key_SUITE_data/verify_hostname.conf 2>/dev/null > public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
+%%
+%% Subject: C=SE, CN=example.com
+%% Subject Alternative Name: DNS:kb.example.org, URI:http://www.example.org, URI:https://wws.example.org
+
+pkix_verify_hostname_subjAltName(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_subjAltName.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that neither a uri nor dns hostname matches a CN if subjAltName is present:
+ false = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"},
+ {dns_id,"example.com"}]),
+
+ %% Check that a uri_id matches a URI subjAltName:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://wws.example.org"}]),
+
+ %% Check that a dns_id does not match a URI subjAltName:
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"www.example.org"},
+ {dns_id,"wws.example.org"}]),
+
+ %% Check that a dns_id matches a DNS subjAltName:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"kb.example.org"}]).
+
+%%--------------------------------------------------------------------
+%% Uses the pem-file for pkix_verify_hostname_cn
+%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org
+pkix_verify_hostname_options(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that the fail_callback is called and is presented the correct certificate:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}],
+ [{fail_callback,
+ fun(#'OTPCertificate'{}=C) when C==Cert ->
+ true; % To test the return value matters
+ (#'OTPCertificate'{}=C) ->
+ ct:log("~p:~p: Wrong cert:~n~p~nExpect~n~p",
+ [?MODULE, ?LINE, C, Cert]),
+ ct:fail("Wrong cert, see log");
+ (C) ->
+ ct:log("~p:~p: Bad cert: ~p",[?MODULE,?LINE,C]),
+ ct:fail("Bad cert, see log")
+ end}]),
+
+ %% Check the callback for user-provided match functions:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"very.wrong.domain"}],
+ [{match_fun,
+ fun("very.wrong.domain", {cn,"example.com"}) ->
+ true;
+ (_, _) ->
+ false
+ end}]),
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"not.example.com"}],
+ [{match_fun, fun(_, _) -> default end}]),
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"example.com"}],
+ [{match_fun, fun(_, _) -> default end}]),
+
+ %% Check the callback for user-provided fqdn extraction:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}],
+ [{fqdn_fun,
+ fun({uri_id, "some://very.wrong.domain"}) ->
+ "example.com";
+ (_) ->
+ ""
+ end}]),
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}],
+ [{fqdn_fun, fun(_) -> default end}]),
+ false = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}]).
+
+%%--------------------------------------------------------------------
pkix_iso_rsa_oid() ->
[{doc, "Test workaround for supporting certs that use ISO oids"
" 1.3.14.3.2.29 instead of PKIX/PKCS oid"}].
diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem
new file mode 100644
index 0000000000..9f7b428f9a
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICsjCCAhugAwIBAgIJAMCGx1ezaJFRMA0GCSqGSIb3DQEBCwUAMHIxCzAJBgNV
+BAYTAlNFMRQwEgYDVQQDDAtleGFtcGxlLmNvbTEaMBgGA1UEAwwRKi5mb28uZXhh
+bXBsZS5jb20xHDAaBgNVBAMME2EqYi5iYXIuZXhhbXBsZS5jb20xEzARBgNVBAoM
+CmVybGFuZy5vcmcwHhcNMTYxMjIwMTUwNDUyWhcNMTcwMTE5MTUwNDUyWjByMQsw
+CQYDVQQGEwJTRTEUMBIGA1UEAwwLZXhhbXBsZS5jb20xGjAYBgNVBAMMESouZm9v
+LmV4YW1wbGUuY29tMRwwGgYDVQQDDBNhKmIuYmFyLmV4YW1wbGUuY29tMRMwEQYD
+VQQKDAplcmxhbmcub3JnMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDVGJgZ
+defGucvMXf0RrEm6Hb18IfVUo9IV6swSP/kwAu/608ZIZdzlfp2pxC0e72a4E3WN
+4vrGxAr2wMMQOiyoy4qlAeLX27THJ6Q4Vl82fc6QuOJbScKIydSZ4KoB+luGlBu5
+b6xYh2pBbneKFpsecmK5rsWtTactjD4n1tKjUwIDAQABo1AwTjAdBgNVHQ4EFgQU
+OCtzidUeaDva7qp12T0CQrgfLW4wHwYDVR0jBBgwFoAUOCtzidUeaDva7qp12T0C
+QrgfLW4wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQsFAAOBgQCAz+ComCMo9Qbu
+PHxG7pv3mQvoxrMFva/Asg4o9mW2mDyrk0DwI4zU8vMHbSRKSBYGm4TATXsQkDQT
+gJw/bxhISnhZZtPC7Yup8kJCkJ6S6EDLYrlzgsRqfeU6jWim3nbfaLyMi9dHFDMk
+HULnyNNW3qxTEKi8Wo2sCMej4l7KFg==
+-----END CERTIFICATE-----
diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
new file mode 100644
index 0000000000..83e1ad37b3
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
@@ -0,0 +1,14 @@
+-----BEGIN CERTIFICATE-----
+MIICEjCCAXugAwIBAgIJANwliLph5EiAMA0GCSqGSIb3DQEBCwUAMCMxCzAJBgNV
+BAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNvbTAeFw0xNjEyMjAxNTEyMjRaFw0x
+NzAxMTkxNTEyMjRaMCMxCzAJBgNVBAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNv
+bTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAydstIN157w8QxkVaOl3wm81j
+fgZ8gqO3BXkECPF6bw5ewLlmePL6Qs4RypsaRe7cKJ9rHFlwhpdcYkxWSWEt2N7Z
+Ry3N4SjuU04ohWbYgy3ijTt7bJg7jOV1Dh56BnI4hwhQj0oNFizNZOeRRfEzdMnS
++uk03t/Qre2NS7KbwnUCAwEAAaNOMEwwSgYDVR0RBEMwQYIOa2IuZXhhbXBsZS5v
+cmeGFmh0dHA6Ly93d3cuZXhhbXBsZS5vcmeGF2h0dHBzOi8vd3dzLmV4YW1wbGUu
+b3JnMA0GCSqGSIb3DQEBCwUAA4GBAKqFqW5gCso422bXriCBJoygokOTTOw1Rzpq
+K8Mm0B8W9rrW9OTkoLEcjekllZcUCZFin2HovHC5HlHZz+mQvBI1M6sN2HVQbSzS
+EgL66U9gwJVnn9/U1hXhJ0LO28aGbyE29DxnewNR741dWN3oFxCdlNaO6eMWaEsO
+gduJ5sDl
+-----END CERTIFICATE-----
diff --git a/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf
new file mode 100644
index 0000000000..a28864dc78
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf
@@ -0,0 +1,16 @@
+[req]
+prompt = no
+distinguished_name = DN
+
+[DN]
+C=SE
+CN=example.com
+
+[SAN]
+subjectAltName = @alt_names
+
+[alt_names]
+DNS = kb.example.org
+URI.1 = http://www.example.org
+URI.2 = https://wws.example.org
+
diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml
index 82a4c79379..7aae5e5c41 100644
--- a/lib/runtime_tools/doc/src/LTTng.xml
+++ b/lib/runtime_tools/doc/src/LTTng.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf8" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE chapter SYSTEM "chapter.dtd">
<chapter>
<header>
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/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml
index fa503fa573..4ca4a08329 100644
--- a/lib/sasl/doc/src/systools.xml
+++ b/lib/sasl/doc/src/systools.xml
@@ -268,7 +268,7 @@
<fsummary>Creates a release package.</fsummary>
<type>
<v>Name = string()</v>
- <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v>
+ <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir} | | no_warn_sasl | warnings_as_errors</v>
<v>&nbsp;Dir = string()</v>
<v>&nbsp;IncDir = src | include | atom()</v>
<v>&nbsp;Var = {VarName,PreFix}</v>
@@ -297,6 +297,10 @@
directory unless <c>Name</c> contains a path. If option
<c>{outdir,Dir}</c> is specified, it is located in <c>Dir</c>
instead.</p>
+ <p>If SASL is not included as an application in
+ the <c>.rel</c> file, a warning is issued because such a
+ release cannot be used in an upgrade. To turn off this
+ warning, add option <c>no_warn_sasl</c>.</p>
<p>By default, the release package contains the directories
<c>lib/App-Vsn/ebin</c> and <c>lib/App-Vsn/priv</c> for each
included application. If more directories are to be included,
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index efe6cc9eb4..3a188e95ee 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -94,7 +94,11 @@ make_script(RelName, Output, Flags) when is_list(RelName),
Warnings = wsasl(Flags, Warnings0),
case systools_lib:werror(Flags, Warnings) of
true ->
- return(ok,Warnings,Flags);
+ Warnings1 = [W || {warning,W}<-Warnings],
+ return({error,?MODULE,
+ {warnings_treated_as_errors,Warnings1}},
+ Warnings,
+ Flags);
false ->
case generate_script(Output,Release,Appls,Flags) of
ok ->
@@ -115,7 +119,6 @@ make_script(RelName, _Output, Flags) when is_list(Flags) ->
make_script(RelName, _Output, Flags) ->
badarg(Flags,[RelName, Flags]).
-
wsasl(Options, Warnings) ->
case lists:member(no_warn_sasl,Options) of
true -> lists:delete({warning,missing_sasl},Warnings);
@@ -148,21 +151,10 @@ get_outdir(Flags) ->
return(ok,Warnings,Flags) ->
case member(silent,Flags) of
true ->
- case systools_lib:werror(Flags, Warnings) of
- true ->
- error;
- false ->
- {ok,?MODULE,Warnings}
- end;
+ {ok,?MODULE,Warnings};
_ ->
- case member(warnings_as_errors,Flags) of
- true ->
- io:format("~ts",[format_warning(Warnings, true)]),
- error;
- false ->
- io:format("~ts",[format_warning(Warnings)]),
- ok
- end
+ io:format("~ts",[format_warning(Warnings)]),
+ ok
end;
return({error,Mod,Error},_,Flags) ->
case member(silent,Flags) of
@@ -300,6 +292,8 @@ add_apply_upgrade(Script,Args) ->
%% {variables,[{Name,AbsString}]}
%% {machine, jam | beam | vee}
%% {var_tar, include | ownfile | omit}
+%% no_warn_sasl
+%% warnings_as_errors
%%
%% The tar file contains:
%% lib/App-Vsn/ebin
@@ -332,13 +326,23 @@ make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) ->
Path = make_set(Path1 ++ code:get_path()),
ModTestP = {member(src_tests, Flags),xref_p(Flags)},
case get_release(RelName, Path, ModTestP, machine(Flags)) of
- {ok, Release, Appls, Warnings} ->
- case catch mk_tar(RelName, Release, Appls, Flags, Path1) of
- ok ->
- return(ok,Warnings,Flags);
- Error ->
- return(Error,Warnings,Flags)
- end;
+ {ok, Release, Appls, Warnings0} ->
+ Warnings = wsasl(Flags, Warnings0),
+ case systools_lib:werror(Flags, Warnings) of
+ true ->
+ Warnings1 = [W || {warning,W}<-Warnings],
+ return({error,?MODULE,
+ {warnings_treated_as_errors,Warnings1}},
+ Warnings,
+ Flags);
+ false ->
+ case catch mk_tar(RelName, Release, Appls, Flags, Path1) of
+ ok ->
+ return(ok,Warnings,Flags);
+ Error ->
+ return(Error,Warnings,Flags)
+ end
+ end;
Error ->
return(Error,[],Flags)
end;
@@ -2109,90 +2113,80 @@ cas([Y | Args], X) ->
%% Check Options for make_tar
check_args_tar(Args) ->
- cat(Args, {undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, []}).
+ cat(Args, []).
-cat([], {_Path,_Sil,_Dirs,_Erts,_Test,_Var,_VarTar,_Mach,_Xref,_XrefApps, X}) ->
+cat([], X) ->
X;
%%% path ---------------------------------------------------------------
-cat([{path, P} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(P) ->
+cat([{path, P} | Args], X) when is_list(P) ->
case check_path(P) of
ok ->
- cat(Args, {P, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X++[{path,P}]})
+ cat(Args, X++[{path,P}])
end;
%%% silent -------------------------------------------------------------
-cat([silent | Args], {Path, _Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, silent, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([silent | Args], X) ->
+ cat(Args, X);
%%% dirs ---------------------------------------------------------------
-cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) ->
+cat([{dirs, D} | Args], X) ->
case check_dirs(D) of
ok ->
- cat(Args, {Path, Sil, D, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X++[{dirs, D}]})
+ cat(Args, X++[{dirs, D}])
end;
%%% erts ---------------------------------------------------------------
-cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)->
- cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([{erts, E} | Args], X) when is_list(E)->
+ cat(Args, X);
%%% src_tests ----------------------------------------------------
-cat([src_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, src_tests, Var, VarTar, Mach,
- Xref, XrefApps, X});
+cat([src_tests | Args], X) ->
+ cat(Args, X);
%%% variables ----------------------------------------------------------
-cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) ->
+cat([{variables, V} | Args], X) when is_list(V) ->
case check_vars(V) of
ok ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, V, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X++[{variables, V}]})
+ cat(Args, X++[{variables, V}])
end;
%%% var_tar ------------------------------------------------------------
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == include ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, include, Mach, Xref, XrefApps, X});
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == ownfile ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, ownfile, Mach, Xref, XrefApps, X});
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == omit ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, omit, Mach, Xref, XrefApps, X});
+cat([{var_tar, VT} | Args], X) when VT == include;
+ VT == ownfile;
+ VT == omit ->
+ cat(Args, X);
%%% machine ------------------------------------------------------------
-cat([{machine, M} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_atom(M) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([{machine, M} | Args], X) when is_atom(M) ->
+ cat(Args, X);
%%% exref --------------------------------------------------------------
-cat([exref | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, _Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, exref, XrefApps, X});
+cat([exref | Args], X) ->
+ cat(Args, X);
%%% exref Apps ---------------------------------------------------------
-cat([{exref, Apps} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Apps) ->
+cat([{exref, Apps} | Args], X) when is_list(Apps) ->
case check_apps(Apps) of
ok ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, Apps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X++[{exref, Apps}]})
+ cat(Args, X++[{exref, Apps}])
end;
%%% outdir Dir ---------------------------------------------------------
-cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Dir) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X});
+cat([{outdir, Dir} | Args], X) when is_list(Dir) ->
+ cat(Args, X);
%%% otp_build (secret, not documented) ---------------------------------
-cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([otp_build | Args], X) ->
+ cat(Args, X);
+%%% warnings_as_errors ----
+cat([warnings_as_errors | Args], X) ->
+ cat(Args, X);
+%%% no_warn_sasl ----
+cat([no_warn_sasl | Args], X) ->
+ cat(Args, X);
%%% no_module_tests (kept for backwards compatibility, but ignored) ----
-cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([no_module_tests | Args], X) ->
+ cat(Args, X);
%%% ERROR --------------------------------------------------------------
-cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}).
+cat([Y | Args], X) ->
+ cat(Args, X++[Y]).
check_path([]) ->
ok;
@@ -2292,6 +2286,9 @@ format_error({delete,File,Error}) ->
[File,file:format_error(Error)]);
format_error({tar_error,What}) ->
form_tar_err(What);
+format_error({warnings_treated_as_errors,Warnings}) ->
+ io_lib:format("Warnings being treated as errors:~n~ts",
+ [map(fun(W) -> form_warn("",W) end, Warnings)]);
format_error(ListOfErrors) when is_list(ListOfErrors) ->
format_errors(ListOfErrors);
format_error(E) -> io_lib:format("~p~n",[E]).
@@ -2348,24 +2345,15 @@ form_tar_err({add, File, Error}) ->
%% Format warning
format_warning(Warnings) ->
- format_warning(Warnings, false).
-
-format_warning(Warnings, Werror) ->
- Prefix = case Werror of
- true ->
- "";
- false ->
- "*WARNING* "
- end,
- map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings).
-
-form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) ->
+ map(fun({warning,W}) -> form_warn("*WARNING* ", W) end, Warnings).
+
+form_warn(Prefix, {source_not_found,{Mod,App,_}}) ->
io_lib:format("~ts~w: Source code not found: ~w.erl~n",
[Prefix,App,Mod]);
form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) ->
io_lib:format("~ts~w: Parse error: ~p~n",
[Prefix,App,File]);
-form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) ->
+form_warn(Prefix, {obj_out_of_date,{Mod,App,_}}) ->
io_lib:format("~ts~w: Object code (~w) out of date~n",
[Prefix,App,Mod]);
form_warn(Prefix, {exref_undef, Undef}) ->
@@ -2375,8 +2363,8 @@ form_warn(Prefix, {exref_undef, Undef}) ->
end,
map(F, Undef);
form_warn(Prefix, missing_sasl) ->
- io_lib:format("~ts: Missing application sasl. "
+ io_lib:format("~tsMissing application sasl. "
"Can not upgrade with this release~n",
[Prefix]);
form_warn(Prefix, What) ->
- io_lib:format("~ts ~p~n", [Prefix,What]).
+ io_lib:format("~ts~p~n", [Prefix,What]).
diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl
index 28534dc0c8..7e1844b400 100644
--- a/lib/sasl/src/systools_relup.erl
+++ b/lib/sasl/src/systools_relup.erl
@@ -155,36 +155,12 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) ->
mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) ->
case check_opts(Opts) of
[] ->
- R = (catch do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs,
- add_code_path(Opts), Opts)),
- case {get_opt(silent, Opts), get_opt(noexec, Opts)} of
- {false, false} ->
- case R of
- {ok, _Res, _Mod, Ws} ->
- print_warnings(Ws, Opts),
- case systools_lib:werror(Opts, Ws) of
- true ->
- error;
- false ->
- ok
- end;
- Other ->
- print_error(Other),
- error
- end;
- _ ->
- case R of
- {ok, _Res, _Mod, Ws} ->
- case systools_lib:werror(Opts, Ws) of
- true ->
- error;
- false ->
- R
- end;
- R ->
- R
- end
- end;
+ R = try do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs,
+ add_code_path(Opts), Opts)
+ catch throw:Error ->
+ Error
+ end,
+ done_mk_relup(Opts, R);
BadArg ->
erlang:error({badarg, BadArg})
end.
@@ -224,17 +200,45 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) ->
{Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs,
Path, Opts, Ws1),
Relup = {TopRel#release.vsn, Up, Dn},
- case systools_lib:werror(Opts, Ws2) of
- true ->
- ok;
- false ->
- write_relup_file(Relup, Opts)
- end,
- {ok, Relup, ?MODULE, Ws2};
+
+ {ok, Relup, Ws2};
Other ->
- throw(Other)
+ Other
end.
+done_mk_relup(Opts, {ok,Relup,Ws}) ->
+ WAE = get_opt(warnings_as_errors,Opts),
+ Silent = get_opt(silent,Opts),
+ Noexec = get_opt(noexec,Opts),
+
+ if WAE andalso Ws=/=[] ->
+ return_error(Silent,
+ {error,?MODULE,{warnings_treated_as_errors, Ws}});
+ not Noexec ->
+ case write_relup_file(Relup,Opts) of
+ ok ->
+ return_ok(Silent,Relup,Ws);
+ Error ->
+ return_error(Silent,Error)
+ end;
+ true -> % noexec
+ return_ok(true,Relup,Ws)
+ end;
+done_mk_relup(Opts, Error) ->
+ return_error(get_opt(silent,Opts) orelse get_opt(noexec,Opts), Error).
+
+return_error(true, Error) ->
+ Error;
+return_error(false, Error) ->
+ print_error(Error),
+ error.
+
+return_ok(true,Relup,Ws) ->
+ {ok,Relup,?MODULE,Ws};
+return_ok(false,_Relup,Ws) ->
+ print_warnings(Ws),
+ ok.
+
%%-----------------------------------------------------------------
%% foreach_baserel_up(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret
%% foreach_baserel_dn(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret
@@ -529,33 +533,18 @@ to_list(X) when is_list(X) -> X.
%% Writes a relup file.
%%
write_relup_file(Relup, Opts) ->
- case get_opt(noexec, Opts) of
- true ->
- ok;
- _ ->
- Filename = case get_opt(outdir, Opts) of
- OutDir when is_list(OutDir) ->
- filename:join(filename:absname(OutDir),
- "relup");
- false ->
- "relup";
- Badarg ->
- throw({error, ?MODULE, {badarg, {outdir,Badarg}}})
- end,
-
- case file:open(Filename, [write]) of
- {ok, Fd} ->
- io:format(Fd, "~p.~n", [Relup]),
- case file:close(Fd) of
- ok -> ok;
- {error,Reason} ->
- throw({error, ?MODULE,
- {file_problem, {"relup", {close,Reason}}}})
- end;
- {error, Reason} ->
- throw({error, ?MODULE,
- {file_problem, {"relup", {open, Reason}}}})
- end
+ Filename = filename:join(filename:absname(get_opt(outdir,Opts)),
+ "relup"),
+ case file:open(Filename, [write]) of
+ {ok, Fd} ->
+ io:format(Fd, "~p.~n", [Relup]),
+ case file:close(Fd) of
+ ok -> ok;
+ {error,Reason} ->
+ {error, ?MODULE, {file_problem, {"relup", {close,Reason}}}}
+ end;
+ {error, Reason} ->
+ {error, ?MODULE, {file_problem, {"relup", {open, Reason}}}}
end.
add_code_path(Opts) ->
@@ -593,10 +582,9 @@ default(path) -> false;
default(noexec) -> false;
default(silent) -> false;
default(restart_emulator) -> false;
-default(outdir) -> false.
+default(outdir) -> ".";
+default(warnings_as_errors) -> false.
-print_error({'EXIT', Err}) ->
- print_error(Err);
print_error({error, Mod, Error}) ->
S = apply(Mod, format_error, [Error]),
io:format(S, []);
@@ -614,24 +602,20 @@ format_error({missing_sasl,Release}) ->
io_lib:format("No sasl application in release ~ts, ~ts. "
"Can not be upgraded.",
[Release#release.name, Release#release.vsn]);
+format_error({warnings_treated_as_errors, Warnings}) ->
+ io_lib:format("Warnings being treated as errors:~n~ts",
+ [[format_warning("",W) || W <- Warnings]]);
format_error(Error) ->
- io:format("~p~n", [Error]).
+ io_lib:format("~p~n", [Error]).
-print_warnings(Ws, Opts) when is_list(Ws) ->
- lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws);
-print_warnings(W, Opts) ->
- print_warning(W, Opts).
+print_warnings(Ws) when is_list(Ws) ->
+ lists:foreach(fun(W) -> print_warning(W) end, Ws);
+print_warnings(W) ->
+ print_warning(W).
-print_warning(W, Opts) ->
- Prefix = case lists:member(warnings_as_errors, Opts) of
- true ->
- "";
- false ->
- "*WARNING* "
- end,
- S = format_warning(Prefix, W),
- io:format("~ts", [S]).
+print_warning(W) ->
+ io:format("~ts", [format_warning(W)]).
format_warning(W) ->
format_warning("*WARNING* ", W).
@@ -639,6 +623,8 @@ format_warning(W) ->
format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) ->
io_lib:format("~tsThe ERTS version changed between ~p and ~p~n",
[Prefix, Rel1, Rel2]);
+format_warning(Prefix, pre_R15_emulator_upgrade) ->
+ io_lib:format("~tsUpgrade from an OTP version earlier than R15. New code should be compiled with the old emulator.~n",[Prefix]);
format_warning(Prefix, What) ->
io_lib:format("~ts~p~n",[Prefix, What]).
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/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index bf95ceb70c..cce73f5bce 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -29,6 +29,8 @@
-module(systools_SUITE).
+-compile(export_all).
+
%%-define(debug, true).
-include_lib("common_test/include/ct.hrl").
@@ -39,31 +41,6 @@
-include_lib("kernel/include/file.hrl").
--export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
--export([script_options/1, normal_script/1, unicode_script/1,
- unicode_script/2, no_mod_vsn_script/1,
- wildcard_script/1, variable_script/1, no_sasl_script/1,
- no_dot_erlang_script/1,
- abnormal_script/1, src_tests_script/1, crazy_script/1,
- included_script/1, included_override_script/1,
- included_fail_script/1, included_bug_script/1, exref_script/1,
- duplicate_modules_script/1,
- otp_3065_circular_dependenies/1, included_and_used_sort_script/1]).
--export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, system_files_tar/1,
- system_files_tar/2, invalid_system_files_tar/1,
- invalid_system_files_tar/2, variable_tar/1,
- src_tests_tar/1, var_tar/1, exref_tar/1, link_tar/1,
- otp_9507_path_ebin/1]).
--export([normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1,
- no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1,
- regexp_relup/1]).
--export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]).
--export([otp_6226_outdir/1]).
--export([init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2]).
--export([delete_tree/1]).
-
-import(lists, [foldl/3]).
-define(default_timeout, ?t:minutes(20)).
@@ -91,7 +68,8 @@ groups() ->
{tar, [],
[tar_options, normal_tar, no_mod_vsn_tar, system_files_tar,
invalid_system_files_tar, variable_tar,
- src_tests_tar, var_tar, exref_tar, link_tar, otp_9507_path_ebin]},
+ src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar,
+ otp_9507_path_ebin]},
{relup, [],
[normal_relup, restart_relup, abnormal_relup, no_sasl_relup,
no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup
@@ -238,6 +216,7 @@ normal_script(Config) when is_list(Config) ->
%% Check the same but w. silent flag
{ok, _, []} = systools:make_script(LatestName, [silent]),
+ {ok, _, []} = systools:make_script(LatestName, [silent,warnings_as_errors]),
%% Use the local option
ok = systools:make_script(LatestName, [local]),
@@ -456,9 +435,16 @@ no_sasl_script(Config) when is_list(Config) ->
{ok, _ , [{warning,missing_sasl}]} =
systools:make_script(LatestName,[{path, P},silent]),
+ {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} =
+ systools:make_script(LatestName,[{path, P},silent,warnings_as_errors]),
+
{ok, _ , []} =
systools:make_script(LatestName,[{path, P},silent, no_warn_sasl]),
+ {ok, _ , []} =
+ systools:make_script(LatestName,[{path, P},silent, no_warn_sasl,
+ warnings_as_errors]),
+
ok = file:set_cwd(OldDir),
ok.
@@ -525,7 +511,9 @@ src_tests_script(Config) when is_list(Config) ->
ok = file:delete(BootFile),
false = filelib:is_regular(BootFile),
%% With warnings_as_errors and src_tests option, an error should be issued
- error =
+ {error, systools_make,
+ {warnings_treated_as_errors, [{obj_out_of_date,_},
+ {source_not_found,_}]}} =
systools:make_script(LatestName, [silent, {path, N}, src_tests,
warnings_as_errors]),
error =
@@ -745,7 +733,7 @@ exref_script(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]),
+ {ok, _, []} = systools:make_script(LatestName, [{path,P}, silent]),
%% Complete exref
{ok, _, W1} =
@@ -894,10 +882,10 @@ normal_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName),
ok = file:set_cwd(OldDir),
@@ -918,10 +906,10 @@ no_mod_vsn_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName),
ok = file:set_cwd(OldDir),
@@ -945,11 +933,11 @@ system_files_tar(Config) ->
ok = file:write_file("sys.config","[].\n"),
ok = file:write_file("relup","{\"LATEST\",[],[]}.\n"),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
ok = check_tar(fname(["releases","LATEST","relup"]), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
ok = check_tar(fname(["releases","LATEST","relup"]), LatestName),
@@ -978,7 +966,7 @@ invalid_system_files_tar(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
%% Add dummy relup and sys.config - faulty sys.config
ok = file:write_file("sys.config","[]\n"), %!!! syntax error - missing '.'
@@ -1036,7 +1024,7 @@ variable_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName,
+ {ok, _, []} = systools:make_script(LatestName,
[silent,
{path, P},
{variables,[{"TEST", LibDir}]}]),
@@ -1045,7 +1033,7 @@ variable_tar(Config) when is_list(Config) ->
{variables,[{"TEST", LibDir}]}]),
ok = check_var_tar("TEST", LatestName),
- {ok, _, _} = systools:make_tar(LatestName,
+ {ok, _, []} = systools:make_tar(LatestName,
[{path, P}, silent,
{variables,[{"TEST", LibDir}]}]),
ok = check_var_tar("TEST", LatestName),
@@ -1174,7 +1162,7 @@ var_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName,
+ {ok, _, []} = systools:make_script(LatestName,
[silent,
{path, P},
{variables,[{"TEST", LibDir}]}]),
@@ -1218,7 +1206,7 @@ exref_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
%% Complete exref
{ok, _, W1} =
@@ -1248,7 +1236,41 @@ exref_tar(Config) when is_list(Config) ->
ok = file:set_cwd(OldDir),
ok.
+%% make_tar: Create tar without sasl appl. Check warning.
+no_sasl_tar(Config) when is_list(Config) ->
+ {ok, OldDir} = file:get_cwd(),
+ {LatestDir, LatestName} = create_script(latest1_no_sasl,Config),
+
+ DataDir = filename:absname(?copydir),
+ LibDir = fname([DataDir, d_normal, lib]),
+ P = [fname([LibDir, '*', ebin]),
+ fname([DataDir, lib, kernel, ebin]),
+ fname([DataDir, lib, stdlib, ebin]),
+ fname([DataDir, lib, sasl, ebin])],
+
+ ok = file:set_cwd(LatestDir),
+
+ {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ ok = systools:make_tar(LatestName, [{path, P}]),
+ {ok, _, [{warning,missing_sasl}]} =
+ systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} =
+ systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl]),
+ {ok, _, []} =
+ systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl,
+ warnings_as_errors]),
+ TarFile = LatestName ++ ".tar.gz",
+ true = filelib:is_regular(TarFile),
+ ok = file:delete(TarFile),
+ {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} =
+ systools:make_tar(LatestName, [{path, P}, silent, warnings_as_errors]),
+ error =
+ systools:make_tar(LatestName, [{path, P}, warnings_as_errors]),
+ false = filelib:is_regular(TarFile),
+
+ ok = file:set_cwd(OldDir),
+ ok.
%% make_tar: OTP-9507 - make_tar failed when path given as just 'ebin'.
otp_9507_path_ebin(Config) when is_list(Config) ->
@@ -1268,7 +1290,7 @@ otp_9507_path_ebin(Config) when is_list(Config) ->
fname([DataDir, lib, kernel, ebin]),
fname([DataDir, lib, stdlib, ebin]),
fname([DataDir, lib, sasl, ebin])],
- {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]),
+ {ok, _, []} = systools:make_script(RelName, [silent, {path, P1}]),
ok = systools:make_tar(RelName, [{path, P1}]),
Content1 = tar_contents(RelName),
@@ -1309,7 +1331,7 @@ normal_relup(Config) when is_list(Config) ->
ok = systools:make_relup(LatestName, [LatestName1], [LatestName1],
[{path, P}]),
ok = check_relup([{db, "2.1"}], [{db, "1.0"}]),
- {ok, _, _, []} =
+ {ok, Relup, _, []} =
systools:make_relup(LatestName, [LatestName1], [LatestName1],
[{path, P}, silent]),
ok = check_relup([{db, "2.1"}], [{db, "1.0"}]),
@@ -1322,7 +1344,9 @@ normal_relup(Config) when is_list(Config) ->
error =
systools:make_relup(LatestName, [LatestName2], [LatestName1],
[{path, P}, warnings_as_errors]),
- error =
+ {error, systools_relup,
+ {warnings_treated_as_errors,[pre_R15_emulator_upgrade,
+ {erts_vsn_changed, _}]}} =
systools:make_relup(LatestName, [LatestName2], [LatestName1],
[{path, P}, silent, warnings_as_errors]),
@@ -1341,6 +1365,14 @@ normal_relup(Config) when is_list(Config) ->
%% relup file should exist now
true = filelib:is_regular("relup"),
+ %% file should not be written if noexec option is used.
+ %% delete before running tests.
+ ok = file:delete("relup"),
+ {ok,Relup,_,[]} =
+ systools:make_relup(LatestName, [LatestName1], [LatestName1],
+ [{path, P}, noexec]),
+ false = filelib:is_regular("relup"),
+
ok = file:set_cwd(OldDir),
ok.
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index ca61782639..db09ec3dc5 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -8,6 +8,10 @@
%% {update, snmpa_local_db, soft, soft_purge, soft_purge, []}
%% {add_module, snmpm_net_if_mt}
[
+ {<<"5\\.2\\.4">>,
+ [{load_module, snmp, soft_purge, soft_purge, []},
+ {load_module, snmpc_lib, soft_purge, soft_purge, []},
+ {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]},
{<<"5\\..*">>, [{restart_application, snmp}]},
{<<"4\\..*">>, [{restart_application, snmp}]}
],
@@ -17,6 +21,10 @@
%% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}}
[
+ {<<"5\\.2\\.4">>,
+ [{load_module, snmp, soft_purge, soft_purge, []},
+ {load_module, snmpc_lib, soft_purge, soft_purge, []},
+ {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]},
{<<"5\\..*">>, [{restart_application, snmp}]},
{<<"4\\..*">>, [{restart_application, snmp}]}
]
diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl
index df3933ea01..8a736f688b 100644
--- a/lib/snmp/src/app/snmp.erl
+++ b/lib/snmp/src/app/snmp.erl
@@ -1,7 +1,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.
@@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) ->
CompDate =
case key1search(compile_time, Info) of
{value, {Year, Month, Day, Hour, Min, Sec}} ->
- lists:flatten(
- io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w",
- [Year, Month, Day, Hour, Min, Sec]));
+ io_lib:format(
+ "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w",
+ [Year, Month, Day, Hour, Min, Sec]);
+ _ ->
+ "Not found"
+ end,
+ Digest =
+ case key1search(md5, Info) of
+ {value, MD5} when is_binary(MD5) ->
+ [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5];
_ ->
"Not found"
end,
@@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) ->
"~s Vsn: ~s~n"
"~s App vsn: ~s~n"
"~s Compiler ver: ~s~n"
- "~s Compile time: ~s~n",
+ "~s Compile time: ~s~n"
+ "~s MD5 digest: ~s~n",
[Prefix, Module,
Prefix, Vsn,
Prefix, AppVsn,
- Prefix, CompVer,
- Prefix, CompDate]),
+ Prefix, CompVer,
+ Prefix, CompDate,
+ Prefix, Digest]),
ok.
key1search(Key, Vals) ->
@@ -617,7 +626,7 @@ versions1() ->
Error ->
Error
end.
-
+
versions2() ->
case ms2() of
{ok, Mods} ->
@@ -625,25 +634,56 @@ versions2() ->
Error ->
Error
end.
-
+
version_info(Mods) ->
SysInfo = sys_info(),
OsInfo = os_info(),
ModInfo = [mod_version_info(Mod) || Mod <- Mods],
[{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}].
-
+
mod_version_info(Mod) ->
Info = Mod:module_info(),
- {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info),
- {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr),
- {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr),
- {value, {compile, Comp}} = lists:keysearch(compile, 1, Info),
- {value, {version, Ver}} = lists:keysearch(version, 1, Comp),
- {value, {time, Time}} = lists:keysearch(time, 1, Comp),
- {Mod, [{vsn, Vsn},
- {app_vsn, AppVsn},
- {compiler_version, Ver},
- {compile_time, Time}]}.
+ {Mod,
+ case key1search(attributes, Info) of
+ {value, Attr} ->
+ case key1search(vsn, Attr) of
+ {value, [Vsn]} ->
+ [{vsn, Vsn}];
+ not_found ->
+ []
+ end ++
+ case key1search(app_vsn, Attr) of
+ {value, AppVsn} ->
+ [{app_vsn, AppVsn}];
+ not_found ->
+ []
+ end;
+ not_found ->
+ []
+ end ++
+ case key1search(compile, Info) of
+ {value, Comp} ->
+ case key1search(version, Comp) of
+ {value, Ver} ->
+ [{compiler_version, Ver}];
+ not_found ->
+ []
+ end ++
+ case key1search(time, Comp) of
+ {value, Ver} ->
+ [{compile_time, Ver}];
+ not_found ->
+ []
+ end;
+ not_found ->
+ []
+ end ++
+ case key1search(md5, Info) of
+ {value, Bin} ->
+ [{md5, Bin}];
+ not_found ->
+ []
+ end}.
sys_info() ->
SysArch = string:strip(erlang:system_info(system_architecture),right,$\n),
diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl
index 51690b6e7e..33ddd78308 100644
--- a/lib/snmp/src/compile/snmpc_lib.erl
+++ b/lib/snmp/src/compile/snmpc_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-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.
@@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) ->
print_error("Undefined type '~w'",[Type],Line),
guess_string_type()
end;
-make_ASN1type({{integer_with_enum,Type,Enums},Line}) ->
+make_ASN1type({{type_with_enum,Type,Enums},Line}) ->
case lookup_vartype(Type) of
{value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]};
false ->
diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl
index 743c3a6550..14a668127e 100644
--- a/lib/snmp/src/compile/snmpc_mib_gram.yrl
+++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl
@@ -1,7 +1,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.
@@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}.
syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}.
syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}.
syntax -> 'INTEGER' '{' namedbits '}' :
- {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
+ {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
syntax -> 'BITS' '{' namedbits '}' :
ensure_ver(2,'$1'),
{{bits, '$3'}, line_of('$1')}.
+syntax -> usertype '{' namedbits '}' :
+ {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
syntax -> 'SEQUENCE' 'OF' usertype :
{{sequence_of,val('$3')},line_of('$1')}.
diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl
index 2c8851c2a7..9b3c2bfd2c 100644
--- a/lib/snmp/test/snmp_compiler_test.erl
+++ b/lib/snmp/test/snmp_compiler_test.erl
@@ -1,7 +1,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.
@@ -56,7 +56,8 @@
otp_8574/1,
otp_8595/1,
otp_10799/1,
- otp_10808/1
+ otp_10808/1,
+ otp_14145/1
]).
@@ -135,7 +136,8 @@ all() ->
].
groups() ->
- [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}].
+ [{tickets, [],
+ [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}].
init_per_group(_GroupName, Config) ->
Config.
@@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) ->
%%======================================================================
+otp_14145(suite) ->
+ [];
+otp_14145(Config) when is_list(Config) ->
+ put(tname, otp10808),
+ p("starting with Config: ~p~n", [Config]),
+
+ Dir = ?config(case_top_dir, Config),
+ MibDir = ?config(mib_dir, Config),
+ MibName = "OTP14145-MIB",
+ MibFile = join(MibDir, MibName++".mib"),
+ ?line {ok, MibBin} =
+ snmpc:compile(MibFile, [{outdir, Dir},
+ {verbosity, trace},
+ {group_check, false},
+ module_compliance]),
+ p("Mib: ~n~p~n", [MibBin]),
+ MIB = read_mib(MibBin),
+ Oid = [1,3,6,1,2,1,67,4],
+ check_mib(MIB#mib.mes, Oid, undefined),
+ ok.
+
+
+%%======================================================================
+
augments_extra_info(suite) ->
[];
augments_extra_info(Config) when is_list(Config) ->
diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib
new file mode 100644
index 0000000000..f29c65c4c2
--- /dev/null
+++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib
@@ -0,0 +1,44 @@
+OTP14145-MIB DEFINITIONS ::= BEGIN
+
+IMPORTS
+ MODULE-IDENTITY, OBJECT-TYPE,
+ mib-2 FROM SNMPv2-SMI
+ InetAddressType, InetAddress FROM INET-ADDRESS-MIB
+ MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF;
+
+testMibId MODULE-IDENTITY
+ LAST-UPDATED "200608210000Z" -- 21 August 2006
+ ORGANIZATION "a"
+ CONTACT-INFO "a"
+ DESCRIPTION "a"
+ REVISION "200608210000Z" -- 21 August 2006
+ DESCRIPTION "a"
+ ::= { mib-2 67 }
+
+testObj OBJECT-TYPE
+ SYNTAX InetAddressType
+ -- SYNTAX InetAddress
+ MAX-ACCESS read-only
+ STATUS current
+ DESCRIPTION "a"
+ ::= { testMibId 2 }
+
+testObjId OBJECT IDENTIFIER ::= { testMibId 3 }
+
+testMibCompliance MODULE-COMPLIANCE
+ STATUS current
+ DESCRIPTION "a"
+ MODULE
+ OBJECT testObj
+ SYNTAX InetAddressType { ipv4(1), ipv6(2) }
+ -- SYNTAX InetAddress ( SIZE(4|16) )
+ DESCRIPTION "a"
+ ::= { testMibId 4 }
+
+testObjGroup OBJECT-GROUP
+ OBJECTS { testObj }
+ STATUS current
+ DESCRIPTION "a"
+ ::= { testObjId 1 }
+
+END
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 28eba0d0d6..30b8ee1124 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -2,7 +2,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
+# Copyright Ericsson AB 1997-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.
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = snmp
-SNMP_VSN = 5.2.4
+SNMP_VSN = 5.2.5
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 6b49f89449..f6e26f5ee8 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -153,7 +153,7 @@
<item>
<p>IP version to use.</p>
</item>
- <tag><c><![CDATA[{user_dir, string()}]]></c></tag>
+ <tag><marker id="opt_user_dir"></marker><c><![CDATA[{user_dir, string()}]]></c></tag>
<item>
<p>Sets the user directory, that is, the directory containing
<c>ssh</c> configuration files for the user, such as
@@ -175,22 +175,48 @@
supplied with this option.
</p>
</item>
- <tag><c><![CDATA[{silently_accept_hosts, boolean() | accept_fun() | {crypto:digest_type(), accept_fun()} }]]></c>
- <br/>
- <c><![CDATA[accept_fun() :: fun(PeerName::string(), FingerPrint::string()) -> boolean()]]></c>
+ <tag>
+ <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/>
+ <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/>
+ <c><![CDATA[{silently_accept_hosts, {HashAlgoSpec, CallbackFun} }]]></c> <br/>
+ <br/>
+ <c><![CDATA[HashAlgoSpec = crypto:digest_type() | [ crypto:digest_type() ] ]]></c><br/>
+ <c><![CDATA[CallbackFun = fun(PeerName, FingerPrint) -> boolean()]]></c><br/>
+ <c><![CDATA[PeerName = string()]]></c><br/>
+ <c><![CDATA[FingerPrint = string() | [ string() ] ]]></c>
</tag>
<item>
- <p>When <c>true</c>, hosts are added to the
- file <c><![CDATA[known_hosts]]></c> without asking the user.
- Defaults to <c>false</c> which will give a user question on stdio of whether to accept or reject a previously
- unseen host.</p>
- <p>If the option value is has an <c>accept_fun()</c>, that fun will called with the arguments
- <c>(PeerName, PeerHostKeyFingerPrint)</c>. The fingerprint is calculated on the Peer's Host Key with
- <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso>.
- </p>
- <p>If the <c>crypto:digest_type()</c> is present, the fingerprint is calculated with that digest type by the function
- <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
- </p>
+ <p>This option guides the <c>connect</c> function how to act when the connected server presents a Host
+ Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to
+ accept or reject the new Host Key.
+ See also the option <seealso marker="#opt_user_dir"><c>user_dir</c></seealso>
+ for the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded.
+ </p>
+ <p>The option can be given in three different forms as seen above:</p>
+ <list>
+ <item>The value is a <c>boolean()</c>. The value <c>true</c> will make the client accept any unknown
+ Host Key without any user interaction. The value <c>false</c> keeps the default behaviour of asking the
+ the user on stdio.
+ </item>
+ <item>A <c>CallbackFun</c> will be called and the boolean return value <c>true</c> will make the client
+ accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and therefore
+ also the connection will be closed. The arguments to the fun are:
+ <list type="bulleted">
+ <item><c>PeerName</c> - a string with the name or address of the remote host.</item>
+ <item><c>FingerPrint</c> - the fingerprint of the Host Key as
+ <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso>
+ calculates it.
+ </item>
+ </list>
+ </item>
+ <item>A tuple <c>{HashAlgoSpec, CallbackFun}</c>. The <c>HashAlgoSpec</c> specifies which hash algorithm
+ shall be used to calculate the fingerprint used in the call of the <c>CallbackFun</c>. The <c>HashALgoSpec</c>
+ is either an atom or a list of atoms as the first argument in
+ <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
+ If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the <c>CallbackFun</c> will be
+ a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list.
+ </item>
+ </list>
</item>
<tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag>
<item>
@@ -200,7 +226,7 @@
supplying a password. Defaults to <c>true</c>.
Even if user interaction is allowed it can be
suppressed by other options, such as <c>silently_accept_hosts</c>
- and <c>password</c>. However, those optins are not always desirable
+ and <c>password</c>. However, those options are not always desirable
to use from a security point of view.</p>
</item>
diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml
index 0861c641c7..864378b640 100644
--- a/lib/ssh/doc/src/using_ssh.xml
+++ b/lib/ssh/doc/src/using_ssh.xml
@@ -305,7 +305,7 @@ ok = erl_tar:close(HandleRead),
<code type="erl" >
-module(ssh_echo_server).
--behaviour(ssh_subsystem).
+-behaviour(ssh_daemon_channel).
-record(state, {
n,
id,
diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src
index 76b7d8cd55..2bb7491b0c 100644
--- a/lib/ssh/src/ssh.app.src
+++ b/lib/ssh/src/ssh.app.src
@@ -48,4 +48,3 @@
"stdlib-3.1"
]}]}.
-
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 31e343e81b..68d98d3875 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -280,9 +280,11 @@ valid_socket_to_use(Socket, Options) ->
{error, {unsupported,L4}}
end.
-is_tcp_socket(Socket) -> {ok,[]} =/= inet:getopts(Socket, [delay_send]).
-
-
+is_tcp_socket(Socket) ->
+ case inet:getopts(Socket, [delay_send]) of
+ {ok,[_]} -> true;
+ _ -> false
+ end.
daemon_shell_opt(Options) ->
case proplists:get_value(shell, Options) of
@@ -317,6 +319,7 @@ start_daemon(Socket, Options) ->
do_start_daemon(Socket, [{role,server}|SshOptions], SocketOptions)
catch
throw:bad_fd -> {error,bad_fd};
+ throw:bad_socket -> {error,bad_socket};
_C:_E -> {error,{cannot_start_daemon,_C,_E}}
end;
{error,SockError} ->
@@ -333,6 +336,7 @@ start_daemon(Host, Port, Options, Inet) ->
do_start_daemon(Host, Port, [{role,server}|SshOptions] , [Inet|SocketOptions])
catch
throw:bad_fd -> {error,bad_fd};
+ throw:bad_socket -> {error,bad_socket};
_C:_E -> {error,{cannot_start_daemon,_C,_E}}
end
end.
@@ -362,8 +366,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
{error, {already_started, _}} ->
{error, eaddrinuse};
Result = {ok,_} ->
- ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket),
- Result;
+ call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, Result);
Result = {error, _} ->
Result
catch
@@ -376,8 +379,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
{error, {already_started, _}} ->
{error, eaddrinuse};
{ok, _} ->
- ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket),
- {ok, Sup};
+ call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, {ok, Sup});
Other ->
Other
end
@@ -447,6 +449,16 @@ do_start_daemon(Host0, Port0, SshOptions, SocketOptions) ->
end
end.
+call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, DefaultResult) ->
+ try ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket)
+ of
+ {error,Error} -> {error,Error};
+ _ -> DefaultResult
+ catch
+ C:R -> {error,{could_not_start_connection,{C,R}}}
+ end.
+
+
sync_request_control(false) ->
ok;
sync_request_control({LSock,Callback}) ->
@@ -620,11 +632,22 @@ handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -
handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_function(Value,2) ->
Opt;
handle_ssh_option({silently_accept_hosts, {DigestAlg,Value}} = Opt) when is_function(Value,2) ->
- case lists:member(DigestAlg, [md5, sha, sha224, sha256, sha384, sha512]) of
- true ->
- Opt;
- false ->
- throw({error, {eoptions, Opt}})
+ Algs = if is_atom(DigestAlg) -> [DigestAlg];
+ is_list(DigestAlg) -> DigestAlg;
+ true -> throw({error, {eoptions, Opt}})
+ end,
+ case [A || A <- Algs,
+ not lists:member(A, [md5, sha, sha224, sha256, sha384, sha512])] of
+ [_|_] = UnSup1 ->
+ throw({error, {{eoptions, Opt}, {not_fingerprint_algos,UnSup1}}});
+ [] ->
+ CryptoHashAlgs = proplists:get_value(hashs, crypto:supports(), []),
+ case [A || A <- Algs,
+ not lists:member(A, CryptoHashAlgs)] of
+ [_|_] = UnSup2 ->
+ throw({error, {{eoptions, Opt}, {unsupported_algo,UnSup2}}});
+ [] -> Opt
+ end
end;
handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) ->
Opt;
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_cli.erl b/lib/ssh/src/ssh_cli.erl
index 8af0ecc5f9..6f8c050486 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -453,14 +453,20 @@ move_cursor(From, To, #ssh_pty{width=Width, term=Type}) ->
%% %%% make sure that there is data to send
%% %%% before calling ssh_connection:send
write_chars(ConnectionHandler, ChannelId, Chars) ->
- case erlang:iolist_size(Chars) of
- 0 ->
- ok;
- _ ->
- ssh_connection:send(ConnectionHandler, ChannelId,
- ?SSH_EXTENDED_DATA_DEFAULT, Chars)
+ case has_chars(Chars) of
+ false -> ok;
+ true -> ssh_connection:send(ConnectionHandler,
+ ChannelId,
+ ?SSH_EXTENDED_DATA_DEFAULT,
+ Chars)
end.
+has_chars([C|_]) when is_integer(C) -> true;
+has_chars([H|T]) when is_list(H) ; is_binary(H) -> has_chars(H) orelse has_chars(T);
+has_chars(<<_:8,_/binary>>) -> true;
+has_chars(_) -> false.
+
+
%%% tail, works with empty lists
tl1([_|A]) -> A;
tl1(_) -> [].
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 7451c9e6d0..4496c657c3 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -609,13 +609,15 @@ handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) ->
%%%---- diffie-hellman group exchange
handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) ->
- {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
+ {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
send_bytes(GexGroup, D),
+ Ssh = ssh_transport:parallell_gen_key(Ssh1),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) ->
- {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
+ {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
send_bytes(GexGroup, D),
+ Ssh = ssh_transport:parallell_gen_key(Ssh1),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) ->
@@ -1206,7 +1208,7 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
catch
_C:_E ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Encountered unexpected input"},
+ description = "Bad packet"},
StateName, D)
end;
@@ -1221,13 +1223,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
{bad_mac, Ssh1} ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad mac"},
+ description = "Bad packet"},
StateName, D0#data{ssh_params=Ssh1});
- {error, {exceeds_max_size,PacketLen}} ->
+ {error, {exceeds_max_size,_PacketLen}} ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet length "
- ++ integer_to_list(PacketLen)},
+ description = "Bad packet"},
StateName, D0)
catch
_C:_E ->
diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl
index dff2bae9f2..0345bbdea7 100644
--- a/lib/ssh/src/ssh_dbg.erl
+++ b/lib/ssh/src/ssh_dbg.erl
@@ -50,50 +50,61 @@ messages(Write, MangleArg) when is_function(Write,2),
is_function(MangleArg,1) ->
catch dbg:start(),
setup_tracer(Write, MangleArg),
- dbg:p(new,c),
+ dbg:p(new,[c,timestamp]),
dbg_ssh_messages().
dbg_ssh_messages() ->
dbg:tp(ssh_message,encode,1, x),
dbg:tp(ssh_message,decode,1, x),
- dbg:tpl(ssh_transport,select_algorithm,3, x).
-
+ dbg:tpl(ssh_transport,select_algorithm,3, x),
+ dbg:tp(ssh_transport,hello_version_msg,1, x),
+ dbg:tp(ssh_transport,handle_hello_version,1, x).
+
%%%----------------------------------------------------------------
stop() ->
dbg:stop().
%%%================================================================
-msg_formater({trace,Pid,call,{ssh_message,encode,[Msg]}}, D) ->
- fmt("~nSEND ~p ~s~n", [Pid,wr_record(shrink_bin(Msg))], D);
-msg_formater({trace,_Pid,return_from,{ssh_message,encode,1},_Res}, D) ->
+msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) ->
+ fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D);
+msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) ->
D;
-msg_formater({trace,_Pid,call,{ssh_message,decode,_}}, D) ->
+msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) ->
D;
-msg_formater({trace,Pid,return_from,{ssh_message,decode,1},Msg}, D) ->
- fmt("~n~p RECV ~s~n", [Pid,wr_record(shrink_bin(Msg))], D);
+msg_formater({trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) ->
+ fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D);
-msg_formater({trace,_Pid,call,{ssh_transport,select_algorithm,_}}, D) ->
+msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) ->
+ D;
+msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg},TS}, D) ->
+ fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D);
+
+msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) ->
D;
-msg_formater({trace,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg}}, D) ->
- fmt("~n~p ALGORITHMS~n~s~n", [Pid, wr_record(Alg)], D);
+msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) ->
+ fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
+msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) ->
+ fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
+msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) ->
+ D;
-msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Pid}, D) ->
- fmt("~n~p TCP SEND on ~p~n ~p~n", [Pid,Sock, shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) ->
+ fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Dest}, D) ->
- fmt("~n~p TCP SEND from ~p TO ~p~n ~p~n", [Pid,Sock,Dest, shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) ->
+ fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,send,ErlangMsg,Dest}, D) ->
- fmt("~n~p ERL MSG SEND TO ~p~n ~p~n", [Pid,Dest, shrink_bin(ErlangMsg)], D);
+msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) ->
+ fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D);
-msg_formater({trace,Pid,'receive',{tcp,Sock,Bytes}}, D) ->
- fmt("~n~p TCP RECEIVE on ~p~n ~p~n", [Pid,Sock,shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) ->
+ fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,'receive',ErlangMsg}, D) ->
- fmt("~n~p ERL MSG RECEIVE~n ~p~n", [Pid,shrink_bin(ErlangMsg)], D);
+msg_formater({trace_ts,Pid,'receive',ErlangMsg,TS}, D) ->
+ fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D);
msg_formater(M, D) ->
@@ -106,6 +117,11 @@ msg_formater(M, D) ->
fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) ->
D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}.
+ts({_,_,Usec}=Now) ->
+ {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
+ io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
+ts(_) ->
+ "-".
%%%----------------------------------------------------------------
setup_tracer(Write, MangleArg) ->
Handler = fun(Arg, D) ->
@@ -116,11 +132,11 @@ setup_tracer(Write, MangleArg) ->
ok.
%%%----------------------------------------------------------------
-shrink_bin(B) when is_binary(B), size(B)>100 -> {'*** SHRINKED BIN',
+shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN',
size(B),
- element(1,split_binary(B,20)),
+ element(1,split_binary(B,64)),
'...',
- element(2,split_binary(B,size(B)-20))
+ element(2,split_binary(B,size(B)-64))
};
shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L);
shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T)));
diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl
index b739955836..9352046795 100644
--- a/lib/ssh/src/ssh_sftpd.erl
+++ b/lib/ssh/src/ssh_sftpd.erl
@@ -664,29 +664,25 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 ->
do_open(ReqId, State, Path, Flags).
do_open(ReqId, State0, Path, Flags) ->
- #state{file_handler = FileMod, file_state = FS0, root = Root, xf = #ssh_xfer{vsn = Vsn}} = State0,
- XF = State0#state.xf,
- F = [binary | Flags],
- {IsDir, _FS1} = FileMod:is_dir(Path, FS0),
+ #state{file_handler = FileMod, file_state = FS0, xf = #ssh_xfer{vsn = Vsn}} = State0,
+ AbsPath = relate_file_name(Path, State0),
+ {IsDir, _FS1} = FileMod:is_dir(AbsPath, FS0),
case IsDir of
true when Vsn > 5 ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory");
+ ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory"),
+ State0;
true ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FAILURE, "File is a directory");
+ ?SSH_FX_FAILURE, "File is a directory"),
+ State0;
false ->
- AbsPath = case Root of
- "" ->
- Path;
- _ ->
- relate_file_name(Path, State0)
- end,
- {Res, FS1} = FileMod:open(AbsPath, F, FS0),
+ OpenFlags = [binary | Flags],
+ {Res, FS1} = FileMod:open(AbsPath, OpenFlags, FS0),
State1 = State0#state{file_state = FS1},
case Res of
{ok, IoDevice} ->
- add_handle(State1, XF, ReqId, file, {Path,IoDevice});
+ add_handle(State1, State0#state.xf, ReqId, file, {Path,IoDevice});
{error, Error} ->
ssh_xfer:xf_send_status(State1#state.xf, ReqId,
ssh_xfer:encode_erlang_status(Error)),
@@ -742,6 +738,10 @@ resolve_symlinks_2([], State, _LinkCnt, AccPath) ->
{{ok, AccPath}, State}.
+%% The File argument is always in a user visible file system, i.e.
+%% is under Root and is relative to CWD or Root, if starts with "/".
+%% The result of the function is always an absolute path in a
+%% "backend" file system.
relate_file_name(File, State) ->
relate_file_name(File, State, _Canonicalize=true).
@@ -749,19 +749,20 @@ relate_file_name(File, State, Canonicalize) when is_binary(File) ->
relate_file_name(unicode:characters_to_list(File), State, Canonicalize);
relate_file_name(File, #state{cwd = CWD, root = ""}, Canonicalize) ->
relate_filename_to_path(File, CWD, Canonicalize);
-relate_file_name(File, #state{root = Root}, Canonicalize) ->
- case is_within_root(Root, File) of
- true ->
- File;
- false ->
- RelFile = make_relative_filename(File),
- NewFile = relate_filename_to_path(RelFile, Root, Canonicalize),
- case is_within_root(Root, NewFile) of
- true ->
- NewFile;
- false ->
- Root
- end
+relate_file_name(File, #state{cwd = CWD, root = Root}, Canonicalize) ->
+ CWD1 = case is_within_root(Root, CWD) of
+ true -> CWD;
+ false -> Root
+ end,
+ AbsFile = case make_relative_filename(File) of
+ File ->
+ relate_filename_to_path(File, CWD1, Canonicalize);
+ RelFile ->
+ relate_filename_to_path(RelFile, Root, Canonicalize)
+ end,
+ case is_within_root(Root, AbsFile) of
+ true -> AbsFile;
+ false -> Root
end.
is_within_root(Root, File) ->
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/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 21ba34506a..a7cc4cd52c 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -44,6 +44,7 @@
handle_kexdh_reply/2,
handle_kex_ecdh_init/2,
handle_kex_ecdh_reply/2,
+ parallell_gen_key/1,
extract_public_key/1,
ssh_packet/2, pack/2,
sha/1, sign/3, verify/4]).
@@ -296,9 +297,6 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own,
end.
-%% TODO: diffie-hellman-group14-sha1 should also be supported.
-%% Maybe check more things ...
-
verify_algorithm(#alg{kex = undefined}) -> false;
verify_algorithm(#alg{hkey = undefined}) -> false;
verify_algorithm(#alg{send_mac = undefined}) -> false;
@@ -316,17 +314,29 @@ verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex)
key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ;
Kex == 'diffie-hellman-group14-sha1' ->
{G, P} = dh_group(Kex),
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Ssh0#ssh.algorithms),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
{SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0),
{ok, SshPacket,
Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}};
key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ;
Kex == 'diffie-hellman-group-exchange-sha256' ->
- {Min,NBits,Max} =
+ {Min,NBits0,Max} =
proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN,
?DEFAULT_DH_GROUP_NBITS,
?DEFAULT_DH_GROUP_MAX}),
+ DhBits = dh_bits(Ssh0#ssh.algorithms),
+ NBits1 =
+ %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management
+ if
+ DhBits =< 112 -> 2048;
+ DhBits =< 128 -> 3072;
+ DhBits =< 192 -> 7680;
+ true -> 8192
+ end,
+ NBits = min(max(max(NBits0,NBits1),Min), Max),
+
{SshPacket, Ssh1} =
ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min,
n = NBits,
@@ -350,12 +360,13 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ;
%%% diffie-hellman-group14-sha1
%%%
handle_kexdh_init(#ssh_msg_kexdh_init{e = E},
- Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) ->
+ Ssh0 = #ssh{algorithms = #alg{kex=Kex} = Algs}) ->
%% server
{G, P} = dh_group(Kex),
if
1=<E, E=<(P-1) ->
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Algs),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
K = compute_key(dh, E, Private, [P,G]),
MyPrivHostKey = get_host_key(Ssh0),
MyPubHostKey = extract_public_key(MyPrivHostKey),
@@ -426,13 +437,12 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0,
{Min, Max} = adjust_gex_min_max(Min0, Max0, Opts),
case public_key:dh_gex_group(Min, NBits, Max,
proplists:get_value(dh_gex_groups,Opts)) of
- {ok, {_Sz, {G,P}}} ->
- {Public, Private} = generate_key(dh, [P,G]),
+ {ok, {_, {G,P}}} ->
{SshPacket, Ssh} =
ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
{ok, SshPacket,
- Ssh#ssh{keyex_key = {{Private, Public}, {G, P}},
- keyex_info = {Min, Max, NBits}
+ Ssh#ssh{keyex_key = {x, {G, P}},
+ keyex_info = {Min0, Max0, NBits}
}};
{error,_} ->
ssh_connection_handler:disconnect(
@@ -461,12 +471,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits},
{Min, Max} = adjust_gex_min_max(Min0, Max0, Opts),
case public_key:dh_gex_group(Min, NBits, Max,
proplists:get_value(dh_gex_groups,Opts)) of
- {ok, {_Sz, {G,P}}} ->
- {Public, Private} = generate_key(dh, [P,G]),
+ {ok, {_, {G,P}}} ->
{SshPacket, Ssh} =
ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
{ok, SshPacket,
- Ssh#ssh{keyex_key = {{Private, Public}, {G, P}},
+ Ssh#ssh{keyex_key = {x, {G, P}},
keyex_info = {-1, -1, NBits} % flag for kex_h hash calc
}};
{error,_} ->
@@ -507,7 +516,8 @@ adjust_gex_min_max(Min0, Max0, Opts) ->
handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) ->
%% client
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Ssh0#ssh.algorithms),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
{SshPacket, Ssh1} =
ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def)
@@ -1117,6 +1127,51 @@ verify(PlainText, Hash, Sig, Key) ->
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Unit: bytes
+
+-record(cipher_data, {
+ key_bytes,
+ iv_bytes,
+ block_bytes
+ }).
+
+%%% Start of a more parameterized crypto handling.
+cipher('AEAD_AES_128_GCM') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 12,
+ block_bytes = 16};
+
+cipher('AEAD_AES_256_GCM') ->
+ #cipher_data{key_bytes = 32,
+ iv_bytes = 12,
+ block_bytes = 16};
+
+cipher('3des-cbc') ->
+ #cipher_data{key_bytes = 24,
+ iv_bytes = 8,
+ block_bytes = 8};
+
+cipher('aes128-cbc') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes128-ctr') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes192-ctr') ->
+ #cipher_data{key_bytes = 24,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes256-ctr') ->
+ #cipher_data{key_bytes = 32,
+ iv_bytes = 16,
+ block_bytes = 16}.
+
+
encrypt_init(#ssh{encrypt = none} = Ssh) ->
{ok, Ssh};
encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) ->
@@ -1497,11 +1552,11 @@ send_mac_init(SSH) ->
common ->
case SSH#ssh.role of
client ->
- KeySize = mac_key_size(SSH#ssh.send_mac),
+ KeySize = 8*mac_key_bytes(SSH#ssh.send_mac),
Key = hash(SSH, "E", KeySize),
{ok, SSH#ssh { send_mac_key = Key }};
server ->
- KeySize = mac_key_size(SSH#ssh.send_mac),
+ KeySize = 8*mac_key_bytes(SSH#ssh.send_mac),
Key = hash(SSH, "F", KeySize),
{ok, SSH#ssh { send_mac_key = Key }}
end;
@@ -1520,10 +1575,10 @@ recv_mac_init(SSH) ->
common ->
case SSH#ssh.role of
client ->
- Key = hash(SSH, "F", mac_key_size(SSH#ssh.recv_mac)),
+ Key = hash(SSH, "F", 8*mac_key_bytes(SSH#ssh.recv_mac)),
{ok, SSH#ssh { recv_mac_key = Key }};
server ->
- Key = hash(SSH, "E", mac_key_size(SSH#ssh.recv_mac)),
+ Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)),
{ok, SSH#ssh { recv_mac_key = Key }}
end;
aead ->
@@ -1640,13 +1695,15 @@ sha(?'secp384r1') -> sha(secp384r1);
sha(?'secp521r1') -> sha(secp521r1).
-mac_key_size('hmac-sha1') -> 20*8;
-mac_key_size('hmac-sha1-96') -> 20*8;
-mac_key_size('hmac-md5') -> 16*8;
-mac_key_size('hmac-md5-96') -> 16*8;
-mac_key_size('hmac-sha2-256')-> 32*8;
-mac_key_size('hmac-sha2-512')-> 512;
-mac_key_size(none) -> 0.
+mac_key_bytes('hmac-sha1') -> 20;
+mac_key_bytes('hmac-sha1-96') -> 20;
+mac_key_bytes('hmac-md5') -> 16;
+mac_key_bytes('hmac-md5-96') -> 16;
+mac_key_bytes('hmac-sha2-256')-> 32;
+mac_key_bytes('hmac-sha2-512')-> 64;
+mac_key_bytes('AEAD_AES_128_GCM') -> 0;
+mac_key_bytes('AEAD_AES_256_GCM') -> 0;
+mac_key_bytes(none) -> 0.
mac_digest_size('hmac-sha1') -> 20;
mac_digest_size('hmac-sha1-96') -> 12;
@@ -1671,6 +1728,13 @@ dh_group('diffie-hellman-group1-sha1') -> ?dh_group1;
dh_group('diffie-hellman-group14-sha1') -> ?dh_group14.
%%%----------------------------------------------------------------
+parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}},
+ algorithms = Algs}) ->
+ Sz = dh_bits(Algs),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
+ Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}.
+
+
generate_key(Algorithm, Args) ->
{Public,Private} = crypto:generate_key(Algorithm, Args),
{crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}.
@@ -1681,6 +1745,15 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) ->
crypto:bytes_to_integer(Shared).
+dh_bits(#alg{encrypt = Encrypt,
+ send_mac = SendMac}) ->
+ C = cipher(Encrypt),
+ 8 * lists:max([C#cipher_data.key_bytes,
+ C#cipher_data.block_bytes,
+ C#cipher_data.iv_bytes,
+ mac_key_bytes(SendMac)
+ ]).
+
ecdh_curve('ecdh-sha2-nistp256') -> secp256r1;
ecdh_curve('ecdh-sha2-nistp384') -> secp384r1;
ecdh_curve('ecdh-sha2-nistp521') -> secp521r1.
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..8ca29b9399 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).
@@ -202,10 +184,7 @@ gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)].
gen_char() -> choose($a,$z).
-gen_mpint() -> ?LET(Size, choose(1,20),
- ?LET(Str, vector(Size, gen_byte()),
- gen_string( strip_0s(Str) )
- )).
+gen_mpint() -> ?LET(I, largeint(), ssh_bits:mpint(I)).
strip_0s([0|T]) -> strip_0s(T);
strip_0s(X) -> X.
@@ -230,13 +209,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 +261,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..6f75d83c4a 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -58,9 +58,11 @@ groups() ->
|| {Tag,Algs} <- ErlAlgos,
lists:member(Tag,tags())
],
+
+ TypeSSH = ssh_test_lib:ssh_type(),
AlgoTcSet =
- [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos)}
+ [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos,TypeSSH)}
|| {Tag,Algs} <- ErlAlgos ++ DoubleAlgos,
Alg <- Algs],
@@ -198,18 +200,17 @@ try_exec_simple_group(Group, Config) ->
%%--------------------------------------------------------------------
%% Testing all default groups
-simple_exec_groups() -> [{timetrap,{minutes,5}}].
-
+simple_exec_groups() ->
+ [{timetrap,{seconds,120}}].
+
simple_exec_groups(Config) ->
Sizes = interpolate( public_key:dh_gex_group_sizes() ),
lists:foreach(
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
@@ -317,18 +318,13 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])).
split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")).
-specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos) ->
+specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) ->
[simple_exec, simple_sftp] ++
case supports(Tag, Alg, SshcAlgos) of
- true ->
- case ssh_test_lib:ssh_type() of
- openSSH ->
- [sshc_simple_exec_os_cmd];
- _ ->
- []
- end;
- false ->
- []
+ true when TypeSSH == openSSH ->
+ [sshc_simple_exec_os_cmd];
+ _ ->
+ []
end ++
case supports(Tag, Alg, SshdAlgos) of
true ->
diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl
index c2bfc48449..c5a6447839 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE.erl
+++ b/lib/ssh/test/ssh_benchmark_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]},
- {timetrap,{minutes,3}}
+ {timetrap,{minutes,6}}
].
%%suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index 8f060bebd8..d07c596411 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -67,7 +67,8 @@
hostkey_fingerprint_check_sha/1,
hostkey_fingerprint_check_sha256/1,
hostkey_fingerprint_check_sha384/1,
- hostkey_fingerprint_check_sha512/1
+ hostkey_fingerprint_check_sha512/1,
+ hostkey_fingerprint_check_list/1
]).
%%% Common test callbacks
@@ -112,6 +113,7 @@ all() ->
hostkey_fingerprint_check_sha256,
hostkey_fingerprint_check_sha384,
hostkey_fingerprint_check_sha512,
+ hostkey_fingerprint_check_list,
id_string_no_opt_client,
id_string_own_string_client,
id_string_random_client,
@@ -812,6 +814,8 @@ hostkey_fingerprint_check_sha384(Config) ->
hostkey_fingerprint_check_sha512(Config) ->
do_hostkey_fingerprint_check(Config, sha512).
+hostkey_fingerprint_check_list(Config) ->
+ do_hostkey_fingerprint_check(Config, [sha,md5,sha256]).
%%%----
do_hostkey_fingerprint_check(Config, HashAlg) ->
@@ -824,20 +828,24 @@ do_hostkey_fingerprint_check(Config, HashAlg) ->
supported_hash(old) -> true;
supported_hash(HashAlg) ->
- proplists:get_value(HashAlg,
- proplists:get_value(hashs, crypto:supports(), []),
- false).
+ Hs = if is_atom(HashAlg) -> [HashAlg];
+ is_list(HashAlg) -> HashAlg
+ end,
+ [] == (Hs -- proplists:get_value(hashs, crypto:supports(), [])).
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
+ FPs0 = [case HashAlg of
old -> public_key:ssh_hostkey_fingerprint(Key);
_ -> public_key:ssh_hostkey_fingerprint(HashAlg, Key)
end
@@ -853,18 +861,25 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
_:_ -> []
end
end],
+ FPs = if is_atom(HashAlg) -> FPs0;
+ is_list(HashAlg) -> lists:concat(FPs0)
+ end,
ct:log("Fingerprints(~p) = ~p",[HashAlg,FPs]),
%% 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) ->
ct:pal("PeerName = ~p, FP = ~p",[PeerName,FP]),
HostCheck = (Host == PeerName),
- FPCheck = lists:member(FP, FPs),
- ct:log("check ~p == ~p (~p) and ~n~p in ~p (~p)~n",
+ FPCheck =
+ if is_atom(HashAlg) -> lists:member(FP, FPs);
+ is_list(HashAlg) -> lists:all(fun(FP1) -> lists:member(FP1,FPs) end,
+ FP)
+ end,
+ ct:log("check ~p == ~p (~p) and ~n~p~n in ~p (~p)~n",
[PeerName,Host,HostCheck,FP,FPs,FPCheck]),
HostCheck and FPCheck
end,
@@ -876,7 +891,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_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 93d0bc2eb0..f9edc5bfc2 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -107,7 +107,10 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ;
TC == gex_client_old_request_noexact ->
Opts = case TC of
gex_client_init_option_groups ->
- [{dh_gex_groups, [{2345, 3, 41}]}];
+ [{dh_gex_groups,
+ [{1023, 5,
+ 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F
+ }]}];
gex_client_init_option_groups_file ->
DataDir = proplists:get_value(data_dir, Config),
F = filename:join(DataDir, "dh_group_test"),
@@ -119,10 +122,12 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ;
_ when TC == gex_server_gex_limit ;
TC == gex_client_old_request_exact ;
TC == gex_client_old_request_noexact ->
- [{dh_gex_groups, [{ 500, 3, 17},
- {1000, 7, 91},
- {3000, 5, 61}]},
- {dh_gex_limits,{500,1500}}
+ [{dh_gex_groups,
+ [{1023, 2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323},
+ {1535, 5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827},
+ {3071, 2, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9429825A2B}
+ ]},
+ {dh_gex_limits, {1023,2000}}
];
_ ->
[]
@@ -351,20 +356,25 @@ no_common_alg_client_disconnects(Config) ->
%%%--------------------------------------------------------------------
gex_client_init_option_groups(Config) ->
- do_gex_client_init(Config, {2000, 2048, 4000},
- {3,41}).
+ do_gex_client_init(Config, {512, 2048, 4000},
+ {5,16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}
+ ).
gex_client_init_option_groups_file(Config) ->
do_gex_client_init(Config, {2000, 2048, 4000},
- {5,61}).
+ {5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}
+ ).
gex_client_init_option_groups_moduli_file(Config) ->
do_gex_client_init(Config, {2000, 2048, 4000},
- {5,16#B7}).
+ {5, 16#DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F}
+ ).
gex_server_gex_limit(Config) ->
do_gex_client_init(Config, {1000, 3000, 4000},
- {7,91}).
+ %% {7,91}).
+ {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}
+ ).
do_gex_client_init(Config, {Min,N,Max}, {G,P}) ->
@@ -390,8 +400,15 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) ->
).
%%%--------------------------------------------------------------------
-gex_client_old_request_exact(Config) -> do_gex_client_init_old(Config, 500, {3,17}).
-gex_client_old_request_noexact(Config) -> do_gex_client_init_old(Config, 800, {7,91}).
+gex_client_old_request_exact(Config) ->
+ do_gex_client_init_old(Config, 1023,
+ {2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323}
+ ).
+
+gex_client_old_request_noexact(Config) ->
+ do_gex_client_init_old(Config, 1400,
+ {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}
+ ).
do_gex_client_init_old(Config, N, {G,P}) ->
{ok,_} =
diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
index 2887bb4b60..87c4b4afc8 100644
--- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
+++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
@@ -1,3 +1,3 @@
-{2222, 5, 61}.
-{1111, 7, 91}.
+{1023, 5, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}.
+{3071, 5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}.
diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
index f6995ba4c9..6d2b4bcb59 100644
--- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
+++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
@@ -1,3 +1,2 @@
-20151021104105 2 6 100 2222 5 B7
-20151021104106 2 6 100 1111 5 4F
-
+20120821044046 2 6 100 1023 2 D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A7711F2C6B
+20120821050554 2 6 100 2047 5 DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F
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_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl
index 52a26110c4..6d18a980ee 100644
--- a/lib/ssh/test/ssh_sftpd_SUITE.erl
+++ b/lib/ssh/test/ssh_sftpd_SUITE.erl
@@ -65,7 +65,12 @@ all() ->
ver3_open_flags,
relpath,
sshd_read_file,
- ver6_basic].
+ ver6_basic,
+ access_outside_root,
+ root_with_cwd,
+ relative_path,
+ open_file_dir_v5,
+ open_file_dir_v6].
groups() ->
[].
@@ -117,6 +122,31 @@ init_per_testcase(TestCase, Config) ->
ver6_basic ->
SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])],
ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ access_outside_root ->
+ %% Build RootDir/access_outside_root/a/b and set Root and CWD
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ RootDir = filename:join(BaseDir, a),
+ CWD = filename:join(RootDir, b),
+ %% Make the directory chain:
+ ok = filelib:ensure_dir(filename:join(CWD, tmp)),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir},
+ {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ root_with_cwd ->
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir}, {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ relative_path ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v5 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v6 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir},
+ {sftpd_vsn, 6}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
_ ->
SubSystems = [ssh_sftpd:subsystem_spec([])],
ssh:daemon(0, [{subsystems, SubSystems}|Options])
@@ -646,6 +676,133 @@ ver6_basic(Config) when is_list(Config) ->
open_file(PrivDir, Cm, Channel, ReqId,
?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+access_outside_root() ->
+ [{doc, "Try access files outside the tree below RootDir"}].
+access_outside_root(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ %% A file outside the tree below RootDir which is BaseDir/a
+ %% Make the file BaseDir/bad :
+ BadFilePath = filename:join([BaseDir, bad]),
+ ok = file:write_file(BadFilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ %% Try to access a file parallell to the RootDir:
+ try_access("/../bad", Cm, Channel, 0),
+ %% Try to access the same file via the CWD which is /b relative to the RootDir:
+ try_access("../../bad", Cm, Channel, 1).
+
+
+try_access(Path, Cm, Channel, ReqId) ->
+ Return =
+ open_file(Path, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ct:log("Try open ~p -> ~p",[Path,Return]),
+ case Return of
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle0/binary>>, _} ->
+ ct:fail("Could open a file outside the root tree!");
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(Code), Rest/binary>>, <<>>} ->
+ case Code of
+ ?SSH_FX_FILE_IS_A_DIRECTORY ->
+ ct:pal("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]),
+ ok;
+ ?SSH_FX_FAILURE ->
+ ct:pal("Got the expected SSH_FX_FAILURE status",[]),
+ ok;
+ _ ->
+ case Rest of
+ <<?UINT32(Len), Txt:Len/binary, _/binary>> ->
+ ct:fail("Got unexpected SSH_FX_code: ~p (~p)",[Code,Txt]);
+ _ ->
+ ct:fail("Got unexpected SSH_FX_code: ~p",[Code])
+ end
+ end;
+ _ ->
+ ct:fail("Completly unexpected return: ~p", [Return])
+ end.
+
+%%--------------------------------------------------------------------
+root_with_cwd() ->
+ [{doc, "Check if files are found, if the CWD and Root are specified"}].
+root_with_cwd(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ FileName = "root_with_cwd.txt",
+ FilePath = filename:join(CWD, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath ++ "0", <<>>),
+ ok = file:write_file(FilePath ++ "1", <<>>),
+ ok = file:write_file(FilePath ++ "2", <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId0 = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId0), _Handle0/binary>>, _} =
+ open_file(FileName ++ "0", Cm, Channel, ReqId0,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId1 = 1,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId1), _Handle1/binary>>, _} =
+ open_file("./" ++ FileName ++ "1", Cm, Channel, ReqId1,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId2 = 2,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId2), _Handle2/binary>>, _} =
+ open_file("/home/" ++ FileName ++ "2", Cm, Channel, ReqId2,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+relative_path() ->
+ [{doc, "Test paths relative to CWD when opening a file handle."}].
+relative_path(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "test_relative_path.txt",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v5() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v5(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v5",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v6() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v6(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v6",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FILE_IS_A_DIRECTORY), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
@@ -688,9 +845,7 @@ reply(Cm, Channel, RBuf) ->
30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
end.
-
open_file(File, Cm, Channel, ReqId, Access, Flags) ->
-
Data = list_to_binary([?uint32(ReqId),
?binary(list_to_binary(File)),
?uint32(Access),
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index f93237f3e7..1673f52821 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, []).
@@ -682,13 +690,16 @@ ssh_type() ->
ssh_type1() ->
try
+ ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]),
case os:find_executable("ssh") of
false ->
ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]),
not_found;
- _ ->
+ Path ->
+ ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]),
case os:cmd("ssh -V") of
- "OpenSSH" ++ _ ->
+ Version = "OpenSSH" ++ _ ->
+ ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]),
openSSH;
Str ->
ct:log("ssh client ~p is unknown",[Str]),
@@ -834,3 +845,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_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index 86c3d5de26..0b9b7acde8 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -36,7 +36,7 @@
%%--------------------------------------------------------------------
suite() ->
- [{timetrap,{seconds,20}}].
+ [{timetrap,{seconds,60}}].
all() ->
case os:find_executable("ssh") of
@@ -464,6 +464,7 @@ erlang_client_openssh_server_renegotiate(_Config) ->
{silently_accept_hosts,true}],
group_leader(IO, self()),
{ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options),
+ ct:pal("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]),
case ssh_connection:session_channel(ConnRef, infinity) of
{ok,ChannelId} ->
success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []),
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/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index b85d8fb284..1b41eae89d 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -11,7 +11,7 @@
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
@@ -62,8 +62,8 @@
</taglist>
</section>
-
- <funcs>
+
+ <funcs>
<func>
<name>delete(Cache, Key) -> _</name>
@@ -134,7 +134,7 @@
</p>
</desc>
</func>
-
+
<func>
<name>select_session(Cache, PartialKey) -> [session()]</name>
<fsummary>Selects sessions that can be reused.</fsummary>
@@ -151,6 +151,21 @@
</func>
<func>
+ <name>size(Cache) -> integer()</name>
+ <fsummary>Returns the number of sessions in the cache.</fsummary>
+ <type>
+ <v>Cache = cache_ref()</v>
+ </type>
+ <desc>
+ <p>Returns the number of sessions in the cache. If size
+ exceeds the maximum number of sessions, the current cache
+ entries will be invalidated regardless of their remaining
+ lifetime. Is to be callable from any process.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>terminate(Cache) -> _</name>
<fsummary>Called by the process that handles the cache when it
is about to terminate.</fsummary>
@@ -178,7 +193,7 @@
</p>
</desc>
</func>
-
- </funcs>
-
+
+ </funcs>
+
</erlref>
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 3dda1a3316..2e7df9792e 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -48,9 +48,17 @@ MODULES= \
dtls \
ssl_alert \
ssl_app \
- ssl_dist_sup\
ssl_sup \
+ ssl_admin_sup\
+ tls_connection_sup \
+ ssl_connection_sup \
+ ssl_listen_tracker_sup\
+ dtls_connection_sup \
+ dtls_udp_listener\
dtls_udp_sup \
+ ssl_dist_sup\
+ ssl_dist_admin_sup\
+ ssl_dist_connection_sup\
inet_tls_dist \
inet6_tls_dist \
ssl_certificate\
@@ -61,21 +69,18 @@ MODULES= \
dtls_connection \
ssl_config \
ssl_connection \
- tls_connection_sup \
- dtls_connection_sup \
tls_handshake \
dtls_handshake\
ssl_handshake\
ssl_manager \
ssl_session \
ssl_session_cache \
+ ssl_pem_cache \
ssl_crl\
ssl_crl_cache \
ssl_crl_hash_dir \
tls_socket \
dtls_socket \
- dtls_udp_listener\
- ssl_listen_tracker_sup \
tls_record \
dtls_record \
ssl_record \
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 070a90d481..f607c86ae3 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -39,7 +39,7 @@
-export([start_fsm/8, start_link/7, init/1]).
%% State transition handling
--export([next_record/1, next_event/3]).
+-export([next_record/1, next_event/3, next_event/4]).
%% Handshake handling
-export([renegotiate/2,
@@ -53,7 +53,7 @@
%% Data handling
-export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4,
- send/3]).
+ send/3, socket/5]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -77,20 +77,6 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
catch
error:{badmatch, {error, _} = Error} ->
Error
- end;
-
-start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts,
- User, {CbModule, _,_, _} = CbInfo,
- Timeout) ->
- try
- {ok, Pid} = dtls_connection_sup:start_child_dist([Role, Host, Port, Socket,
- Opts, User, CbInfo]),
- {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
- ok = ssl_connection:handshake(SslSocket, Timeout),
- {ok, SslSocket}
- catch
- error:{badmatch, {error, _} = Error} ->
- Error
end.
send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) ->
@@ -201,6 +187,7 @@ reinit_handshake_data(#state{protocol_buffers = Buffers} = State) ->
State#state{premaster_secret = undefined,
public_key_info = undefined,
tls_handshake_history = ssl_handshake:init_handshake_history(),
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
protocol_buffers =
Buffers#protocol_buffers{
dtls_handshake_next_seq = 0,
@@ -213,6 +200,9 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) ->
select_sni_extension(_) ->
undefined.
+socket(Pid, Transport, Socket, Connection, _) ->
+ dtls_socket:socket(Pid, Transport, Socket, Connection).
+
%%====================================================================
%% tls_connection_sup API
%%====================================================================
@@ -243,7 +233,7 @@ callback_mode() ->
state_functions.
%%--------------------------------------------------------------------
-%% State functionsconnection/2
+%% State functions
%%--------------------------------------------------------------------
init({call, From}, {start, Timeout},
@@ -262,17 +252,19 @@ init({call, From}, {start, Timeout},
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions),
State1 = prepare_flight(State0#state{negotiated_version = Version}),
- State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
+ {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
State3 = State2#state{negotiated_version = Version, %% Requested version
session =
Session0#session{session_id = Hello#client_hello.session_id},
start_or_recv_from = From,
- timer = Timer},
+ timer = Timer,
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
+ },
{Record, State} = next_record(State3),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) ->
ssl_connection:init(Type, Event,
- State#state{flight_state = {waiting, undefined, ?INITIAL_RETRANSMIT_TIMEOUT}},
+ State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}},
?MODULE);
init({call, _} = Type, Event, #state{role = server} = State) ->
%% I.E. DTLS over sctp
@@ -302,9 +294,9 @@ hello(internal, #client_hello{cookie = <<>>,
Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello),
VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version),
State1 = prepare_flight(State0#state{negotiated_version = Version}),
- State2 = send_handshake(VerifyRequest, State1),
+ {State2, Actions} = send_handshake(VerifyRequest, State1),
{Record, State} = next_record(State2),
- next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()});
+ next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions);
hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server,
transport_cb = Transport,
socket = Socket} = State0) ->
@@ -333,13 +325,13 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client,
Cache, CacheCb, Renegotiation, OwnCert),
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions),
- State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
+ {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
State3 = State2#state{negotiated_version = Version, %% Requested version
session =
Session0#session{session_id =
Hello#client_hello.session_id}},
{Record, State} = next_record(State3),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
negotiated_version = ReqVersion,
@@ -356,13 +348,13 @@ hello(internal, #server_hello{} = Hello,
hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, State) ->
%% Initial hello should not be in handshake history
{next_state, hello, State, [{next_event, internal, Handshake}]};
-
hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) ->
%% hello_verify should not be in handshake history
{next_state, hello, State, [{next_event, internal, Handshake}]};
-
hello(info, Event, State) ->
handle_info(Event, hello, State);
+hello(state_timeout, Event, State) ->
+ handle_state_timeout(Event, hello, State);
hello(Type, Event, State) ->
ssl_connection:hello(Type, Event, State, ?MODULE).
@@ -375,7 +367,11 @@ abbreviated(internal = Type,
ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read),
ssl_connection:abbreviated(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
- ssl_connection:cipher(Type, Event, prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE);
+ ssl_connection:abbreviated(Type, Event,
+ prepare_flight(State#state{connection_states = ConnectionStates,
+ flight_state = connection}), ?MODULE);
+abbreviated(state_timeout, Event, State) ->
+ handle_state_timeout(Event, abbreviated, State);
abbreviated(Type, Event, State) ->
ssl_connection:abbreviated(Type, Event, State, ?MODULE).
@@ -383,6 +379,8 @@ certify(info, Event, State) ->
handle_info(Event, certify, State);
certify(internal = Type, #server_hello_done{} = Event, State) ->
ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE);
+certify(state_timeout, Event, State) ->
+ handle_state_timeout(Event, certify, State);
certify(Type, Event, State) ->
ssl_connection:certify(Type, Event, State, ?MODULE).
@@ -395,7 +393,11 @@ cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event,
ssl_connection:cipher(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
ssl_connection:cipher(Type, Event,
- prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE);
+ prepare_flight(State#state{connection_states = ConnectionStates,
+ flight_state = connection}),
+ ?MODULE);
+cipher(state_timeout, Event, State) ->
+ handle_state_timeout(Event, cipher, State);
cipher(Type, Event, State) ->
ssl_connection:cipher(Type, Event, State, ?MODULE).
@@ -409,12 +411,12 @@ connection(internal, #hello_request{}, #state{host = Host, port = Port,
renegotiation = {Renegotiation, _}} = State0) ->
Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
- State1 = send_handshake(Hello, State0),
+ {State1, Actions} = send_handshake(Hello, State0),
{Record, State} =
next_record(
State1#state{session = Session0#session{session_id
= Hello#client_hello.session_id}}),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) ->
%% Mitigate Computational DoS attack
%% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html
@@ -434,7 +436,6 @@ connection(Type, Event, State) ->
downgrade(Type, Event, State) ->
ssl_connection:downgrade(Type, Event, State, ?MODULE).
-
%%--------------------------------------------------------------------
%% Description: This function is called by a gen_fsm when it receives any
%% other message than a synchronous or asynchronous event
@@ -442,16 +443,6 @@ downgrade(Type, Event, State) ->
%%--------------------------------------------------------------------
%% raw data from socket, unpack records
-handle_info({_,flight_retransmission_timeout}, connection, _) ->
- {next_state, keep_state_and_data};
-handle_info({Ref, flight_retransmission_timeout}, StateName,
- #state{flight_state = {waiting, Ref, NextTimeout}} = State0) ->
- State1 = send_handshake_flight(State0#state{flight_state = {retransmit_timer, NextTimeout}},
- retransmit_epoch(StateName, State0)),
- {Record, State} = next_record(State1),
- next_event(StateName, Record, State);
-handle_info({_, flight_retransmission_timeout}, _, _) ->
- {next_state, keep_state_and_data};
handle_info({Protocol, _, _, _, Data}, StateName,
#state{data_tag = Protocol} = State0) ->
case next_dtls_record(Data, State0) of
@@ -489,7 +480,6 @@ handle_call(Event, From, StateName, State) ->
handle_common_event(internal, #alert{} = Alert, StateName,
#state{negotiated_version = Version} = State) ->
ssl_connection:handle_own_alert(Alert, Version, StateName, State);
-
%%% DTLS record protocol level handshake messages
handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
fragment = Data},
@@ -498,19 +488,14 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
negotiated_version = Version} = State0) ->
try
case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of
- {more_data, Buffers} ->
+ {[], Buffers} ->
{Record, State} = next_record(State0#state{protocol_buffers = Buffers}),
next_event(StateName, Record, State);
{Packets, Buffers} ->
State = State0#state{protocol_buffers = Buffers},
Events = dtls_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
+ {next_state, StateName,
+ State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
end
catch throw:#alert{} = Alert ->
ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
@@ -534,6 +519,13 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta
handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
{next_state, StateName, State}.
+handle_state_timeout(flight_retransmission_timeout, StateName,
+ #state{flight_state = {retransmit, NextTimeout}} = State0) ->
+ {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}},
+ retransmit_epoch(StateName, State0)),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State, Actions).
+
send(Transport, {_, {{_,_}, _} = Socket}, Data) ->
send(Transport, Socket, Data);
send(Transport, Socket, Data) ->
@@ -645,7 +637,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User,
allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
protocol_cb = ?MODULE,
- flight_buffer = new_flight()
+ flight_buffer = new_flight(),
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
}.
next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{
@@ -714,14 +707,14 @@ next_event(connection = StateName, no_record,
#state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
case next_record_if_active(State0) of
{no_record, State} ->
- ssl_connection:hibernate_after(StateName, State, Actions);
+ ssl_connection:hibernate_after(StateName, State, Actions);
{#ssl_tls{epoch = CurrentEpoch} = Record, State} ->
{next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
{#ssl_tls{epoch = Epoch,
type = ?HANDSHAKE,
version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- State = send_handshake_flight(State1, Epoch),
- {next_state, StateName, State, Actions};
+ {State, MoreActions} = send_handshake_flight(State1, Epoch),
+ {next_state, StateName, State, Actions ++ MoreActions};
{#ssl_tls{epoch = _Epoch,
version = _Version}, State} ->
%% TODO maybe buffer later epoch
@@ -772,17 +765,20 @@ next_flight(Flight) ->
Flight#{handshakes => [],
change_cipher_spec => undefined,
handshakes_after_change_cipher_spec => []}.
-
start_flight(#state{transport_cb = gen_udp,
- flight_state = {retransmit_timer, Timeout}} = State) ->
- Ref = erlang:make_ref(),
- _ = erlang:send_after(Timeout, self(), {Ref, flight_retransmission_timeout}),
- State#state{flight_state = {waiting, Ref, new_timeout(Timeout)}};
-
+ flight_state = {retransmit, Timeout}} = State) ->
+ start_retransmision_timer(Timeout, State);
+start_flight(#state{transport_cb = gen_udp,
+ flight_state = connection} = State) ->
+ {State, []};
start_flight(State) ->
%% No retransmision needed i.e DTLS over SCTP
- State#state{flight_state = reliable}.
+ {State#state{flight_state = reliable}, []}.
+
+start_retransmision_timer(Timeout, State) ->
+ {State#state{flight_state = {retransmit, new_timeout(Timeout)}},
+ [{state_timeout, Timeout, flight_retransmission_timeout}]}.
new_timeout(N) when N =< 30 ->
N * 2;
@@ -806,13 +802,13 @@ renegotiate(#state{role = server,
connection_states = CS0} = State0, Actions) ->
HelloRequest = ssl_handshake:hello_request(),
CS = CS0#{write_msg_seq => 0},
- State1 = send_handshake(HelloRequest,
- State0#state{connection_states =
- CS}),
+ {State1, MoreActions} = send_handshake(HelloRequest,
+ State0#state{connection_states =
+ CS}),
Hs0 = ssl_handshake:init_handshake_history(),
{Record, State} = next_record(State1#state{tls_handshake_history = Hs0,
protocol_buffers = #protocol_buffers{}}),
- next_event(hello, Record, State, Actions).
+ next_event(hello, Record, State, Actions ++ MoreActions).
handle_alerts([], Result) ->
Result;
@@ -823,15 +819,11 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
-retransmit_epoch(StateName, #state{connection_states = ConnectionStates}) ->
+retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) ->
#{epoch := Epoch} =
ssl_record:current_connection_state(ConnectionStates, write),
- case StateName of
- connection ->
- Epoch-1;
- _ ->
- Epoch
- end.
+ Epoch.
+
update_handshake_history(#hello_verify_request{}, _, Hist) ->
Hist;
@@ -846,3 +838,4 @@ unprocessed_events(Events) ->
%% handshake events left to process before we should
%% process more TLS-records received on the socket.
erlang:length(Events)-1.
+
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index af3708ddb7..fd1f9698fe 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -136,9 +136,11 @@ handshake_bin([Type, Length, Data], Seq) ->
%%--------------------------------------------------------------------
-spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) ->
- {[{dtls_handshake(), binary()}], #protocol_buffers{}} | {more_data, #protocol_buffers{}}.
+ {[dtls_handshake()], #protocol_buffers{}}.
%%
-%% Description: ...
+%% Description: Given buffered and new data from dtls_record, collects
+%% and returns it as a list of handshake messages, also returns
+%% possible leftover data in the new "protocol_buffers".
%%--------------------------------------------------------------------
get_dtls_handshake(Version, Fragment, ProtocolBuffers) ->
handle_fragments(Version, Fragment, ProtocolBuffers, []).
@@ -288,8 +290,6 @@ do_handle_fragments(_, [], Buffers, Acc) ->
{lists:reverse(Acc), Buffers};
do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) ->
case reassemble(Version, Fragment, Buffers0) of
- {more_data, _} = More when Acc == []->
- More;
{more_data, Buffers} when Fragments == [] ->
{lists:reverse(Acc), Buffers};
{more_data, Buffers} ->
diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl
index 570b3ae83a..ac1a7b37c6 100644
--- a/lib/ssl/src/dtls_socket.erl
+++ b/lib/ssl/src/dtls_socket.erl
@@ -71,11 +71,14 @@ connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo,
close(gen_udp, {_Client, _Socket}) ->
ok.
+socket(Pid, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) ->
+ #sslsocket{pid = Pid,
+ %% "The name "fd" is keept for backwards compatibility
+ fd = {Transport, Socket, ConnectionCb}};
socket(Pid, Transport, Socket, ConnectionCb) ->
#sslsocket{pid = Pid,
%% "The name "fd" is keept for backwards compatibility
- fd = {Transport, Socket, ConnectionCb}}.
-
+ fd = {Transport, Socket, ConnectionCb}}.
%% Vad göra med emulerade
setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) ->
{SockOpts, _} = tls_socket:split_options(Options),
@@ -108,11 +111,15 @@ getstat(gen_udp, {_,Socket}, Options) ->
inet:getstat(Socket, Options);
getstat(Transport, Socket, Options) ->
Transport:getstat(Socket, Options).
+peername(udp, _) ->
+ {error, enotconn};
peername(gen_udp, {_, {Client, _Socket}}) ->
{ok, Client};
peername(Transport, Socket) ->
Transport:peername(Socket).
-sockname(gen_udp, {_,Socket}) ->
+sockname(gen_udp, {_, {_,Socket}}) ->
+ inet:sockname(Socket);
+sockname(gen_udp, Socket) ->
inet:sockname(Socket);
sockname(Transport, Socket) ->
Transport:sockname(Socket).
diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl
index b7f115582e..ab3d0783bd 100644
--- a/lib/ssl/src/dtls_udp_listener.erl
+++ b/lib/ssl/src/dtls_udp_listener.erl
@@ -24,7 +24,8 @@
-behaviour(gen_server).
%% API
--export([start_link/4, active_once/3, accept/2, sockname/1]).
+-export([start_link/4, active_once/3, accept/2, sockname/1, close/1,
+ get_all_opts/1]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -39,7 +40,8 @@
clients = set_new(),
dtls_processes = kv_new(),
accepters = queue:new(),
- first
+ first,
+ close
}).
%%%===================================================================
@@ -53,10 +55,14 @@ active_once(UDPConnection, Client, Pid) ->
gen_server:cast(UDPConnection, {active_once, Client, Pid}).
accept(UDPConnection, Accepter) ->
- gen_server:call(UDPConnection, {accept, Accepter}, infinity).
+ call(UDPConnection, {accept, Accepter}).
sockname(UDPConnection) ->
- gen_server:call(UDPConnection, sockname, infinity).
+ call(UDPConnection, sockname).
+close(UDPConnection) ->
+ call(UDPConnection, close).
+get_all_opts(UDPConnection) ->
+ call(UDPConnection, get_all_opts).
%%%===================================================================
%%% gen_server callbacks
@@ -69,10 +75,13 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) ->
first = true,
dtls_options = DTLSOptions,
emulated_options = EmOpts,
- listner = Socket}}
+ listner = Socket,
+ close = false}}
catch _:_ ->
{error, closed}
end.
+handle_call({accept, _}, _, #state{close = true} = State) ->
+ {reply, {error, closed}, State};
handle_call({accept, Accepter}, From, #state{first = true,
accepters = Accepters,
@@ -87,7 +96,21 @@ handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) ->
{noreply, State};
handle_call(sockname, _, #state{listner = Socket} = State) ->
Reply = inet:sockname(Socket),
- {reply, Reply, State}.
+ {reply, Reply, State};
+handle_call(close, _, #state{dtls_processes = Processes,
+ accepters = Accepters} = State) ->
+ case kv_empty(Processes) of
+ true ->
+ {stop, normal, ok, State#state{close=true}};
+ false ->
+ lists:foreach(fun({_, From}) ->
+ gen_server:reply(From, {error, closed})
+ end, queue:to_list(Accepters)),
+ {reply, ok, State#state{close = true, accepters = queue:new()}}
+ end;
+handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions,
+ emulated_options = EmOpts} = State) ->
+ {reply, {ok, EmOpts, DTLSOptions}, State}.
handle_cast({active_once, Client, Pid}, State0) ->
State = handle_active_once(Client, Pid, State0),
@@ -99,11 +122,17 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta
{noreply, State};
handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients,
- dtls_processes = Processes0} = State) ->
+ dtls_processes = Processes0,
+ close = ListenClosed} = State) ->
Client = kv_get(Pid, Processes0),
Processes = kv_delete(Pid, Processes0),
- {noreply, State#state{clients = set_delete(Client, Clients),
- dtls_processes = Processes}}.
+ case ListenClosed andalso kv_empty(Processes) of
+ true ->
+ {stop, normal, State};
+ false ->
+ {noreply, State#state{clients = set_delete(Client, Clients),
+ dtls_processes = Processes}}
+ end.
terminate(_Reason, _State) ->
ok.
@@ -182,6 +211,7 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes,
gen_server:reply(From, {error, Reason}),
State
end.
+
kv_update(Key, Value, Store) ->
gb_trees:update(Key, Value, Store).
kv_lookup(Key, Store) ->
@@ -194,6 +224,8 @@ kv_delete(Key, Store) ->
gb_trees:delete(Key, Store).
kv_new() ->
gb_trees:empty().
+kv_empty(Store) ->
+ gb_trees:is_empty(Store).
set_new() ->
gb_sets:empty().
@@ -203,3 +235,15 @@ set_delete(Item, Set) ->
gb_sets:delete(Item, Set).
set_is_member(Item, Set) ->
gb_sets:is_member(Item, Set).
+
+call(Server, Msg) ->
+ try
+ gen_server:call(Server, Msg, infinity)
+ catch
+ exit:{noproc, _} ->
+ {error, closed};
+ exit:{normal, _} ->
+ {error, closed};
+ exit:{{shutdown, _},_} ->
+ {error, closed}
+ end.
diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl
index ffd3e4b833..dd0d35d404 100644
--- a/lib/ssl/src/dtls_v1.erl
+++ b/lib/ssl/src/dtls_v1.erl
@@ -21,12 +21,21 @@
-include("ssl_cipher.hrl").
--export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1]).
+-export([suites/1, all_suites/1, mac_hash/7, ecc_curves/1,
+ corresponding_tls_version/1, corresponding_dtls_version/1]).
-spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()].
suites(Minor) ->
- tls_v1:suites(corresponding_minor_tls_version(Minor)).
+ lists:filter(fun(Cipher) ->
+ is_acceptable_cipher(ssl_cipher:suite_definition(Cipher))
+ end,
+ tls_v1:suites(corresponding_minor_tls_version(Minor))).
+all_suites(Version) ->
+ lists:filter(fun(Cipher) ->
+ is_acceptable_cipher(ssl_cipher:suite_definition(Cipher))
+ end,
+ ssl_cipher:all_suites(corresponding_tls_version(Version))).
mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) ->
tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version,
@@ -50,3 +59,5 @@ corresponding_minor_dtls_version(2) ->
255;
corresponding_minor_dtls_version(3) ->
253.
+is_acceptable_cipher(Suite) ->
+ not ssl_cipher:is_stream_ciphersuite(Suite).
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 9c5d795848..064dcd6892 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -10,12 +10,14 @@
tls_v1,
ssl_v3,
ssl_v2,
+ tls_connection_sup,
%% DTLS
dtls_connection,
dtls_handshake,
dtls_record,
dtls_socket,
dtls_v1,
+ dtls_connection_sup,
dtls_udp_listener,
dtls_udp_sup,
%% API
@@ -31,16 +33,19 @@
ssl_cipher,
ssl_srp_primes,
ssl_alert,
- ssl_listen_tracker_sup,
+ ssl_listen_tracker_sup, %% may be used by DTLS over SCTP
%% Erlang Distribution over SSL/TLS
inet_tls_dist,
inet6_tls_dist,
ssl_tls_dist_proxy,
ssl_dist_sup,
- %% SSL/TLS session handling
+ ssl_dist_connection_sup,
+ ssl_dist_admin_sup,
+ %% SSL/TLS session and cert handling
ssl_session,
ssl_session_cache,
ssl_manager,
+ ssl_pem_cache,
ssl_pkix_db,
ssl_certificate,
%% CRL handling
@@ -51,14 +56,14 @@
%% App structure
ssl_app,
ssl_sup,
- tls_connection_sup,
- dtls_connection_sup
+ ssl_admin_sup,
+ ssl_connection_sup
]},
{registered, [ssl_sup, ssl_manager]},
{applications, [crypto, public_key, kernel, stdlib]},
{env, []},
{mod, {ssl_app, []}},
- {runtime_dependencies, ["stdlib-3.1","public_key-1.2","kernel-3.0",
+ {runtime_dependencies, ["stdlib-3.2","public_key-1.2","kernel-3.0",
"erts-7.0","crypto-3.3", "inets-5.10.7"]}]}.
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index 32252386b4..bfdd0c205b 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,11 +1,19 @@
%% -*- erlang -*-
{"%VSN%",
[
- {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
- {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
+ {<<"8\\..*">>, [{restart_application, ssl}]},
+ {<<"7\\..*">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
+ {<<"4\\..*">>, [{restart_application, ssl}]},
+ {<<"3\\..*">>, [{restart_application, ssl}]}
],
[
- {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
- {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
- ]
+ {<<"8\\..*">>, [{restart_application, ssl}]},
+ {<<"7\\..*">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
+ {<<"4\\..*">>, [{restart_application, ssl}]},
+ {<<"3\\..*">>, [{restart_application, ssl}]}
+ ]
}.
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index c72ee44a95..ed04c7e67b 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -187,16 +187,24 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
ssl_accept(Socket, Timeout);
-ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when
+ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
try
- {ok, EmOpts, InheritedSslOpts} = tls_socket:get_all_opts(Tracker),
- SslOpts = handle_options(SslOpts0, InheritedSslOpts),
+ {ok, EmOpts, _} = tls_socket:get_all_opts(Tracker),
ssl_connection:handshake(Socket, {SslOpts,
tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout)
catch
Error = {error, _Reason} -> Error
end;
+ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when
+ (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
+ try
+ {ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid),
+ ssl_connection:handshake(Socket, {SslOpts,
+ tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout)
+ catch
+ Error = {error, _Reason} -> Error
+ end;
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
{Transport,_,_,_} =
@@ -215,7 +223,6 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
catch
Error = {error, _Reason} -> Error
end.
-
%%--------------------------------------------------------------------
-spec close(#sslsocket{}) -> term().
%%
@@ -223,6 +230,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
%%--------------------------------------------------------------------
close(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT});
+close(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) ->
+ dtls_udp_listener:close(Pid);
close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) ->
Transport:close(ListenSocket).
@@ -251,6 +260,8 @@ send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) ->
ssl_connection:send(Pid, Data);
send(#sslsocket{pid = {_, #config{transport_info={gen_udp, _, _, _}}}}, _) ->
{error,enotconn}; %% Emulate connection behaviour
+send(#sslsocket{pid = {udp,_}}, _) ->
+ {error,enotconn};
send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) ->
Transport:send(ListenSocket, Data). %% {error,enotconn}
@@ -265,6 +276,8 @@ recv(Socket, Length) ->
recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
ssl_connection:recv(Pid, Length, Timeout);
+recv(#sslsocket{pid = {udp,_}}, _, _) ->
+ {error,enotconn};
recv(#sslsocket{pid = {Listen,
#config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)->
Transport:recv(Listen, 0). %% {error,enotconn}
@@ -277,10 +290,14 @@ recv(#sslsocket{pid = {Listen,
%%--------------------------------------------------------------------
controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) ->
ssl_connection:new_user(Pid, NewOwner);
+controlling_process(#sslsocket{pid = {udp, _}},
+ NewOwner) when is_pid(NewOwner) ->
+ ok; %% Meaningless but let it be allowed to conform with TLS
controlling_process(#sslsocket{pid = {Listen,
#config{transport_info = {Transport, _, _, _}}}},
NewOwner) when is_port(Listen),
is_pid(NewOwner) ->
+ %% Meaningless but let it be allowed to conform with normal sockets
Transport:controlling_process(Listen, NewOwner).
@@ -297,7 +314,9 @@ connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) ->
Error
end;
connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
- {error, enotconn}.
+ {error, enotconn};
+connection_information(#sslsocket{pid = {udp,_}}) ->
+ {error,enotconn}.
%%--------------------------------------------------------------------
-spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}.
@@ -333,10 +352,18 @@ connection_info(#sslsocket{} = SSLSocket) ->
%%
%% Description: same as inet:peername/1.
%%--------------------------------------------------------------------
+peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)->
+ dtls_socket:peername(Transport, Socket);
peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)->
tls_socket:peername(Transport, Socket);
+peername(#sslsocket{pid = {udp = Transport, #config{udp_handler = {_Pid, _}}}}) ->
+ dtls_socket:peername(Transport, undefined);
+peername(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) ->
+ dtls_socket:peername(Transport, Socket);
peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) ->
- tls_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn}
+ tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn}
+peername(#sslsocket{pid = {udp,_}}) ->
+ {error,enotconn}.
%%--------------------------------------------------------------------
-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
@@ -350,6 +377,8 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) ->
Result ->
Result
end;
+peercert(#sslsocket{pid = {udp, _}}) ->
+ {error, enotconn};
peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
{error, enotconn}.
@@ -506,6 +535,8 @@ getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_
shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}},
How) when is_port(Listen) ->
Transport:shutdown(Listen, How);
+shutdown(#sslsocket{pid = {udp,_}},_) ->
+ {error, enotconn};
shutdown(#sslsocket{pid = Pid}, How) ->
ssl_connection:shutdown(Pid, How).
@@ -518,7 +549,7 @@ sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _
tls_socket:sockname(Transport, Listen);
sockname(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) ->
dtls_udp_listener:sockname(Pid);
-sockname(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) ->
+sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) ->
dtls_socket:sockname(Transport, Socket);
sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) ->
tls_socket:sockname(Transport, Socket).
@@ -531,6 +562,8 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)
%%--------------------------------------------------------------------
session_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:session_info(Pid);
+session_info(#sslsocket{pid = {udp,_}}) ->
+ {error, enotconn};
session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
{error, enotconn}.
@@ -555,6 +588,8 @@ versions() ->
%%--------------------------------------------------------------------
renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:renegotiation(Pid);
+renegotiate(#sslsocket{pid = {udp,_}}) ->
+ {error, enotconn};
renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
{error, enotconn}.
@@ -568,6 +603,8 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
prf(#sslsocket{pid = Pid},
Secret, Label, Seed, WantedLength) when is_pid(Pid) ->
ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength);
+prf(#sslsocket{pid = {udp,_}}, _,_,_,_) ->
+ {error, enotconn};
prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
{error, enotconn}.
@@ -577,7 +614,7 @@ prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
%% Description: Clear the PEM cache
%%--------------------------------------------------------------------
clear_pem_cache() ->
- ssl_manager:clear_pem_cache().
+ ssl_pem_cache:clear().
%%---------------------------------------------------------------
-spec format_error({error, term()}) -> list().
@@ -696,7 +733,7 @@ handle_options(Opts0, Role) ->
[RecordCb:protocol_version(Vsn) || Vsn <- Vsns]
end,
- Protocol = proplists:get_value(protocol, Opts, tls),
+ Protocol = handle_option(protocol, Opts, tls),
SSLOptions = #ssl_options{
versions = Versions,
@@ -755,7 +792,7 @@ handle_options(Opts0, Role) ->
honor_ecc_order = handle_option(honor_ecc_order, Opts,
default_option_role(server, false, Role),
server, Role),
- protocol = Protocol,
+ protocol = Protocol,
padding_check = proplists:get_value(padding_check, Opts, true),
beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one),
fallback = handle_option(fallback, Opts,
@@ -765,7 +802,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 +818,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 +1067,12 @@ 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(protocol, Value = tls) ->
+ Value;
+validate_option(protocol, Value = dtls) ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {options, {Opt, Value}}}).
@@ -1065,17 +1110,37 @@ validate_binary_list(Opt, List) ->
(Bin) ->
throw({error, {options, {Opt, {invalid_protocol, Bin}}}})
end, List).
-
validate_versions([], Versions) ->
Versions;
validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
Version == 'tlsv1.1';
Version == tlsv1;
Version == sslv3 ->
- validate_versions(Rest, Versions);
+ tls_validate_versions(Rest, Versions);
+validate_versions([Version | Rest], Versions) when Version == 'dtlsv1';
+ Version == 'dtlsv2'->
+ dtls_validate_versions(Rest, Versions);
validate_versions([Ver| _], Versions) ->
throw({error, {options, {Ver, {versions, Versions}}}}).
+tls_validate_versions([], Versions) ->
+ Versions;
+tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
+ Version == 'tlsv1.1';
+ Version == tlsv1;
+ Version == sslv3 ->
+ tls_validate_versions(Rest, Versions);
+tls_validate_versions([Ver| _], Versions) ->
+ throw({error, {options, {Ver, {versions, Versions}}}}).
+
+dtls_validate_versions([], Versions) ->
+ Versions;
+dtls_validate_versions([Version | Rest], Versions) when Version == 'dtlsv1';
+ Version == 'dtlsv2'->
+ dtls_validate_versions(Rest, Versions);
+dtls_validate_versions([Ver| _], Versions) ->
+ throw({error, {options, {Ver, {versions, Versions}}}}).
+
validate_inet_option(mode, Value)
when Value =/= list, Value =/= binary ->
throw({error, {options, {mode,Value}}});
@@ -1147,18 +1212,18 @@ handle_cipher_option(Value, Version) when is_list(Value) ->
binary_cipher_suites(Version, []) ->
%% Defaults to all supported suites that does
%% not require explicit configuration
- ssl_cipher:filter_suites(ssl_cipher:suites(Version));
+ ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) ->
Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
binary_cipher_suites(Version, Ciphers);
binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
- All = ssl_cipher:all_suites(Version),
+ All = ssl_cipher:all_suites(tls_version(Version)),
case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of
[] ->
%% Defaults to all supported suites that does
%% not require explicit configuration
- ssl_cipher:filter_suites(ssl_cipher:suites(Version));
+ ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
Ciphers ->
Ciphers
end;
@@ -1171,7 +1236,8 @@ binary_cipher_suites(Version, Ciphers0) ->
Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")],
binary_cipher_suites(Version, Ciphers).
-handle_eccs_option(Value, {_Major, Minor}) when is_list(Value) ->
+handle_eccs_option(Value, Version) when is_list(Value) ->
+ {_Major, Minor} = tls_version(Version),
try tls_v1:ecc_curves(Minor, Value) of
Curves -> #elliptic_curves{elliptic_curve_list = Curves}
catch
@@ -1344,7 +1410,10 @@ new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordC
handle_hashsigns_option(Value,
tls_version(RecordCB:highest_protocol_version()))},
RecordCB);
-
+new_ssl_options([{protocol, dtls = Value} | Rest], #ssl_options{} = Opts, dtls_record = RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB);
+new_ssl_options([{protocol, tls = Value} | Rest], #ssl_options{} = Opts, tls_record = RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB);
new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) ->
throw({error, {options, {Key, Value}}}).
diff --git a/lib/ssl/src/ssl_admin_sup.erl b/lib/ssl/src/ssl_admin_sup.erl
new file mode 100644
index 0000000000..9c96435753
--- /dev/null
+++ b/lib/ssl/src/ssl_admin_sup.erl
@@ -0,0 +1,95 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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(ssl_admin_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0, manager_opts/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+ PEMCache = pem_cache_child_spec(),
+ SessionCertManager = session_and_cert_manager_child_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}.
+
+manager_opts() ->
+ CbOpts = case application:get_env(ssl, session_cb) of
+ {ok, Cb} when is_atom(Cb) ->
+ InitArgs = session_cb_init_args(),
+ [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
+ _ ->
+ []
+ end,
+ case application:get_env(ssl, session_lifetime) of
+ {ok, Time} when is_integer(Time) ->
+ [{session_lifetime, Time}| CbOpts];
+ _ ->
+ CbOpts
+ end.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+pem_cache_child_spec() ->
+ Name = ssl_pem_cache,
+ StartFunc = {ssl_pem_cache, start_link, [[]]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_pem_cache],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+session_and_cert_manager_child_spec() ->
+ Opts = manager_opts(),
+ Name = ssl_manager,
+ StartFunc = {ssl_manager, start_link, [Opts]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_manager],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+session_cb_init_args() ->
+ case application:get_env(ssl, session_cb_init_args) of
+ {ok, Args} when is_list(Args) ->
+ Args;
+ _ ->
+ []
+ end.
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index f359655d85..8aa2aa4081 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -125,21 +125,21 @@ file_to_crls(File, DbHandle) ->
%% Description: Validates ssl/tls specific extensions
%%--------------------------------------------------------------------
validate(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage',
- extnValue = KeyUse}}, {Role, _,_, _, _}) ->
+ extnValue = KeyUse}}, UserState = {Role, _,_, _, _}) ->
case is_valid_extkey_usage(KeyUse, Role) of
true ->
- {valid, Role};
+ {valid, UserState};
false ->
{fail, {bad_cert, invalid_ext_key_usage}}
end;
-validate(_, {extension, _}, Role) ->
- {unknown, Role};
+validate(_, {extension, _}, UserState) ->
+ {unknown, UserState};
validate(_, {bad_cert, _} = Reason, _) ->
{fail, Reason};
-validate(_, valid, Role) ->
- {valid, Role};
-validate(_, valid_peer, Role) ->
- {valid, Role}.
+validate(_, valid, UserState) ->
+ {valid, UserState};
+validate(_, valid_peer, UserState) ->
+ {valid, UserState}.
%%--------------------------------------------------------------------
-spec is_valid_key_usage(list(), term()) -> boolean().
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 32fec03b8e..8e6860e9dc 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -40,7 +40,8 @@
ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0,
rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1,
- random_bytes/1, calc_aad/3, calc_mac_hash/4]).
+ random_bytes/1, calc_aad/3, calc_mac_hash/4,
+ is_stream_ciphersuite/1]).
-export_type([cipher_suite/0,
erl_cipher_suite/0, openssl_cipher_suite/0,
@@ -310,18 +311,21 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState,
%%--------------------------------------------------------------------
suites({3, 0}) ->
ssl_v3:suites();
-suites({3, N}) ->
- tls_v1:suites(N);
-suites(Version) ->
- suites(dtls_v1:corresponding_tls_version(Version)).
+suites({3, Minor}) ->
+ tls_v1:suites(Minor);
+suites({_, Minor}) ->
+ dtls_v1:suites(Minor).
-all_suites(Version) ->
+all_suites({3, _} = Version) ->
suites(Version)
++ anonymous_suites(Version)
++ psk_suites(Version)
++ srp_suites()
++ rc4_suites(Version)
- ++ des_suites(Version).
+ ++ des_suites(Version);
+all_suites(Version) ->
+ dtls_v1:all_suites(Version).
+
%%--------------------------------------------------------------------
-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
%%
@@ -1541,6 +1545,10 @@ calc_mac_hash(Type, Version,
MacSecret, SeqNo, Type,
Length, PlainFragment).
+is_stream_ciphersuite({_, rc4_128, _, _}) ->
+ true;
+is_stream_ciphersuite(_) ->
+ false.
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl
index 0652d029c3..09d4c3e678 100644
--- a/lib/ssl/src/ssl_config.erl
+++ b/lib/ssl/src/ssl_config.erl
@@ -32,18 +32,20 @@ init(SslOpts, Role) ->
init_manager_name(SslOpts#ssl_options.erl_dist),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbHandle, OwnCert}
+ {ok, #{pem_cache := PemCache} = Config}
= init_certificates(SslOpts, Role),
PrivateKey =
- init_private_key(PemCacheHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
+ init_private_key(PemCache, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
SslOpts#ssl_options.password, Role),
- DHParams = init_diffie_hellman(PemCacheHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, PrivateKey, DHParams}.
+ DHParams = init_diffie_hellman(PemCache, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
+ {ok, Config#{private_key => PrivateKey, dh_params => DHParams}}.
init_manager_name(false) ->
- put(ssl_manager, ssl_manager:manager_name(normal));
+ put(ssl_manager, ssl_manager:name(normal)),
+ put(ssl_pem_cache, ssl_pem_cache:name(normal));
init_manager_name(true) ->
- put(ssl_manager, ssl_manager:manager_name(dist)).
+ put(ssl_manager, ssl_manager:name(dist)),
+ put(ssl_pem_cache, ssl_pem_cache:name(dist)).
init_certificates(#ssl_options{cacerts = CaCerts,
cacertfile = CACertFile,
@@ -51,7 +53,7 @@ init_certificates(#ssl_options{cacerts = CaCerts,
cert = Cert,
crl_cache = CRLCache
}, Role) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo} =
+ {ok, Config} =
try
Certs = case CaCerts of
undefined ->
@@ -59,41 +61,37 @@ init_certificates(#ssl_options{cacerts = CaCerts,
_ ->
{der, CaCerts}
end,
- {ok, _, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role, CRLCache)
+ {ok,_} = ssl_manager:connection_init(Certs, Role, CRLCache)
catch
_:Reason ->
file_error(CACertFile, {cacertfile, Reason})
end,
- init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle,
- CacheHandle, CRLDbInfo, CertFile, Role).
+ init_certificates(Cert, Config, CertFile, Role).
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle,
- CRLDbInfo, <<>>, _) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined};
+init_certificates(undefined, Config, <<>>, _) ->
+ {ok, Config#{own_certificate => undefined}};
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle,
- CacheHandle, CRLDbInfo, CertFile, client) ->
+init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, client) ->
try
%% Ignoring potential proxy-certificates see:
%% http://dev.globus.org/wiki/Security/ProxyFileFormat
- [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, OwnCert}
+ [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache),
+ {ok, Config#{own_certificate => OwnCert}}
catch _Error:_Reason ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined}
- end;
+ {ok, Config#{own_certificate => undefined}}
+ end;
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle,
- PemCacheHandle, CacheRef, CRLDbInfo, CertFile, server) ->
+init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server) ->
try
- [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, OwnCert}
+ [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache),
+ {ok, Config#{own_certificate => OwnCert}}
catch
_:Reason ->
file_error(CertFile, {certfile, Reason})
end;
-init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, _, _) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, Cert}.
-
+init_certificates(Cert, Config, _, _) ->
+ {ok, Config#{own_certificate => Cert}}.
+
init_private_key(_, undefined, <<>>, _Password, _Client) ->
undefined;
init_private_key(DbHandle, undefined, KeyFile, Password, _) ->
@@ -135,6 +133,8 @@ file_error(File, Throw) ->
case Throw of
{Opt,{badmatch, {error, {badmatch, Error}}}} ->
throw({options, {Opt, binary_to_list(File), Error}});
+ {Opt, {badmatch, Error}} ->
+ throw({options, {Opt, binary_to_list(File), Error}});
_ ->
throw(Throw)
end.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 6e7c8c5ddd..5244db31af 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -148,19 +148,19 @@ socket_control(Connection, Socket, Pid, Transport) ->
%%--------------------------------------------------------------------
socket_control(Connection, Socket, Pid, Transport, udp_listner) ->
%% dtls listner process must have the socket control
- {ok, dtls_socket:socket(Pid, Transport, Socket, Connection)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)};
socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)};
{error, Reason} ->
{error, Reason}
end;
socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)};
{error, Reason} ->
{error, Reason}
end.
@@ -323,8 +323,14 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}.
%%--------------------------------------------------------------------
ssl_config(Opts, Role, State) ->
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo,
- OwnCert, Key, DHParams} =
+ {ok, #{cert_db_ref := Ref,
+ cert_db_handle := CertDbHandle,
+ fileref_db_handle := FileRefHandle,
+ session_cache := CacheHandle,
+ crl_db_info := CRLDbHandle,
+ private_key := Key,
+ dh_params := DHParams,
+ own_certificate := OwnCert}} =
ssl_config:init(Opts, Role),
Handshake = ssl_handshake:init_handshake_history(),
TimeStamp = erlang:monotonic_time(),
@@ -335,7 +341,7 @@ ssl_config(Opts, Role, State) ->
file_ref_db = FileRefHandle,
cert_db_ref = Ref,
cert_db = CertDbHandle,
- crl_db = CRLDbInfo,
+ crl_db = CRLDbHandle,
session_cache = CacheHandle,
private_key = Key,
diffie_hellman_params = DHParams,
@@ -357,11 +363,13 @@ init({call, From}, {start, Timeout}, State0, Connection) ->
timer = Timer}),
Connection:next_event(hello, Record, State);
init({call, From}, {start, {Opts, EmOpts}, Timeout},
- #state{role = Role} = State0, Connection) ->
+ #state{role = Role, ssl_options = OrigSSLOptions,
+ socket_options = SockOpts} = State0, Connection) ->
try
- State = ssl_config(Opts, Role, State0),
+ SslOpts = ssl:handle_options(Opts, OrigSSLOptions),
+ State = ssl_config(SslOpts, Role, State0),
init({call, From}, {start, Timeout},
- State#state{ssl_options = Opts, socket_options = EmOpts}, Connection)
+ State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection)
catch throw:Error ->
{stop_and_reply, normal, {reply, From, {error, Error}}}
end;
@@ -426,11 +434,11 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
verified ->
ConnectionStates1 =
ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0),
- State1 =
+ {State1, Actions} =
finalize_handshake(State0#state{connection_states = ConnectionStates1},
abbreviated, Connection),
{Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection),
- Connection:next_event(connection, Record, State);
+ Connection:next_event(connection, Record, State, Actions);
#alert{} = Alert ->
handle_own_alert(Alert, Version, abbreviated, State0)
end;
@@ -850,6 +858,7 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName,
StateName, State);
handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State,
_) ->
+ ct:pal("Unexpected msg ~p", [Msg]),
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE),
handle_own_alert(Alert, Version, {StateName, Msg}, State).
@@ -864,11 +873,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 +1019,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,
@@ -1227,13 +1239,13 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite,
negotiated_version = Version} = State0, Connection) ->
try server_certify_and_key_exchange(State0, Connection) of
#state{} = State1 ->
- State2 = server_hello_done(State1, Connection),
+ {State2, Actions} = server_hello_done(State1, Connection),
Session =
Session0#session{session_id = SessionId,
cipher_suite = CipherSuite,
compression_method = Compression},
{Record, State} = Connection:next_record(State2#state{session = Session}),
- Connection:next_event(certify, Record, State)
+ Connection:next_event(certify, Record, State, Actions)
catch
#alert{} = Alert ->
handle_own_alert(Alert, Version, hello, State0)
@@ -1248,10 +1260,10 @@ resumed_server_hello(#state{session = Session,
{_, ConnectionStates1} ->
State1 = State0#state{connection_states = ConnectionStates1,
session = Session},
- State2 =
+ {State2, Actions} =
finalize_handshake(State1, abbreviated, Connection),
{Record, State} = Connection:next_record(State2),
- Connection:next_event(abbreviated, Record, State);
+ Connection:next_event(abbreviated, Record, State, Actions);
#alert{} = Alert ->
handle_own_alert(Alert, Version, hello, State0)
end.
@@ -1334,12 +1346,12 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} =
State0, Connection) ->
try do_client_certify_and_key_exchange(State0, Connection) of
State1 = #state{} ->
- State2 = finalize_handshake(State1, certify, Connection),
+ {State2, Actions} = finalize_handshake(State1, certify, Connection),
State3 = State2#state{
%% Reinitialize
client_certificate_requested = false},
{Record, State} = Connection:next_record(State3),
- Connection:next_event(cipher, Record, State)
+ Connection:next_event(cipher, Record, State, Actions)
catch
throw:#alert{} = Alert ->
handle_own_alert(Alert, Version, certify, State0)
@@ -1861,11 +1873,11 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
Connection) ->
ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data,
ConnectionStates0),
- State1 =
+ {State1, Actions} =
finalize_handshake(State0#state{connection_states = ConnectionStates1,
session = Session}, cipher, Connection),
{Record, State} = prepare_connection(State1, Connection),
- Connection:next_event(connection, Record, State).
+ Connection:next_event(connection, Record, State, Actions).
is_anonymous(Algo) when Algo == dh_anon;
Algo == ecdh_anon;
@@ -2296,7 +2308,7 @@ format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet,
{ok, do_format_reply(Mode, Packet, Header, Data)};
format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet,
header = Header}, Data, Tracker, Connection) ->
- {ssl, tls_socket:socket(self(), Transport, Socket, Connection, Tracker),
+ {ssl, Connection:socket(self(), Transport, Socket, Connection, Tracker),
do_format_reply(Mode, Packet, Header, Data)}.
deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) ->
@@ -2305,7 +2317,7 @@ deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Da
format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _, _) ->
{error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}};
format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker, Connection) ->
- {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker),
+ {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker),
{invalid_packet, do_format_reply(Mode, raw, 0, Data)}}.
do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode
@@ -2360,11 +2372,11 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio
case ssl_alert:reason_code(Alert, Role) of
closed ->
send_or_reply(Active, Pid, From,
- {ssl_closed, tls_socket:socket(self(),
+ {ssl_closed, Connection:socket(self(),
Transport, Socket, Connection, Tracker)});
ReasonCode ->
send_or_reply(Active, Pid, From,
- {ssl_error, tls_socket:socket(self(),
+ {ssl_error, Connection:socket(self(),
Transport, Socket, Connection, Tracker), ReasonCode})
end.
@@ -2425,16 +2437,23 @@ handle_sni_extension(#sni{hostname = Hostname}, State0) ->
undefined ->
State0;
_ ->
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, Key, DHParams} =
- ssl_config:init(NewOptions, State0#state.role),
- State0#state{
- session = State0#state.session#session{own_certificate = OwnCert},
- file_ref_db = FileRefHandle,
- cert_db_ref = Ref,
- cert_db = CertDbHandle,
- crl_db = CRLDbHandle,
- session_cache = CacheHandle,
- private_key = Key,
+ {ok, #{cert_db_ref := Ref,
+ cert_db_handle := CertDbHandle,
+ fileref_db_handle := FileRefHandle,
+ session_cache := CacheHandle,
+ crl_db_info := CRLDbHandle,
+ private_key := Key,
+ dh_params := DHParams,
+ own_certificate := OwnCert}} =
+ ssl_config:init(NewOptions, State0#state.role),
+ State0#state{
+ session = State0#state.session#session{own_certificate = OwnCert},
+ file_ref_db = FileRefHandle,
+ cert_db_ref = Ref,
+ cert_db = CertDbHandle,
+ crl_db = CRLDbHandle,
+ session_cache = CacheHandle,
+ private_key = Key,
diffie_hellman_params = DHParams,
ssl_options = NewOptions,
sni_hostname = Hostname
@@ -2456,3 +2475,8 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) ->
_ ->
ssl:handle_options(SSLOption, OrigSSLOptions)
end.
+
+new_emulated([], EmOpts) ->
+ EmOpts;
+new_emulated(NewEmOpts, _) ->
+ NewEmOpts.
diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl
new file mode 100644
index 0000000000..1a1f43e683
--- /dev/null
+++ b/lib/ssl/src/ssl_connection_sup.erl
@@ -0,0 +1,101 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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(ssl_connection_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+
+ TLSConnetionManager = tls_connection_manager_child_spec(),
+ %% Handles emulated options so that they inherited by the accept
+ %% socket, even when setopts is performed on the listen socket
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
+
+ DTLSConnetionManager = dtls_connection_manager_child_spec(),
+ DTLSUdpListeners = dtls_udp_listeners_spec(),
+
+ {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager,
+ ListenOptionsTracker,
+ DTLSConnetionManager,
+ DTLSUdpListeners
+ ]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+tls_connection_manager_child_spec() ->
+ Name = tls_connection,
+ StartFunc = {tls_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+dtls_connection_manager_child_spec() ->
+ Name = dtls_connection,
+ StartFunc = {dtls_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [dtls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = tls_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+dtls_udp_listeners_spec() ->
+ Name = dtls_udp_listener,
+ StartFunc = {dtls_udp_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl
index fc60bdba67..33375b5e09 100644
--- a/lib/ssl/src/ssl_crl.erl
+++ b/lib/ssl/src/ssl_crl.erl
@@ -29,7 +29,7 @@
-export([trusted_cert_and_path/3]).
-trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) ->
+trusted_cert_and_path(CRL, {SerialNumber, Issuer},{_, {Db, DbRef}} = DbHandle) ->
case ssl_pkix_db:lookup_trusted_cert(Db, DbRef, SerialNumber, Issuer) of
undefined ->
trusted_cert_and_path(CRL, issuer_not_found, DbHandle);
@@ -37,17 +37,34 @@ trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) ->
{ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
{ok, Root, lists:reverse(Chain)}
end;
-
-trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbHandle) ->
- case find_issuer(CRL, DbHandle) of
+trusted_cert_and_path(CRL, issuer_not_found, {CertPath, {Db, DbRef}}) ->
+ case find_issuer(CRL, {certpath,
+ [{Der, public_key:pkix_decode_cert(Der,otp)} || Der <- CertPath]}) of
{ok, OtpCert} ->
{ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
{ok, Root, lists:reverse(Chain)};
{error, issuer_not_found} ->
- {ok, unknown_crl_ca, []}
- end.
+ trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef})
+ end;
+trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbInfo) ->
+ case find_issuer(CRL, DbInfo) of
+ {ok, OtpCert} ->
+ {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
+ {ok, Root, lists:reverse(Chain)};
+ {error, issuer_not_found} ->
+ {error, unknown_ca}
+ end.
-find_issuer(CRL, {Db,DbRef}) ->
+find_issuer(CRL, {certpath = Db, DbRef}) ->
+ Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)),
+ IsIssuerFun =
+ fun({_Der,ErlCertCandidate}, Acc) ->
+ verify_crl_issuer(CRL, ErlCertCandidate, Issuer, Acc);
+ (_, Acc) ->
+ Acc
+ end,
+ find_issuer(IsIssuerFun, Db, DbRef);
+find_issuer(CRL, {Db, DbRef}) ->
Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)),
IsIssuerFun =
fun({_Key, {_Der,ErlCertCandidate}}, Acc) ->
@@ -55,26 +72,33 @@ find_issuer(CRL, {Db,DbRef}) ->
(_, Acc) ->
Acc
end,
- if is_reference(DbRef) -> % actual DB exists
- try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of
- issuer_not_found ->
- {error, issuer_not_found}
- catch
- {ok, _} = Result ->
- Result
- end;
- is_tuple(DbRef), element(1,DbRef) =:= extracted -> % cache bypass byproduct
- {extracted, CertsData} = DbRef,
- Certs = [Entry || {decoded, Entry} <- CertsData],
- try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
- issuer_not_found ->
- {error, issuer_not_found}
- catch
- {ok, _} = Result ->
- Result
- end
- end.
+ find_issuer(IsIssuerFun, Db, DbRef).
+find_issuer(IsIssuerFun, certpath, Certs) ->
+ try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end;
+find_issuer(IsIssuerFun, extracted, CertsData) ->
+ Certs = [Entry || {decoded, Entry} <- CertsData],
+ try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end;
+find_issuer(IsIssuerFun, Db, _) ->
+ try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end.
verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) ->
TBSCert = ErlCertCandidate#'OTPCertificate'.tbsCertificate,
diff --git a/lib/ssl/src/ssl_dist_admin_sup.erl b/lib/ssl/src/ssl_dist_admin_sup.erl
new file mode 100644
index 0000000000..f60806c4cb
--- /dev/null
+++ b/lib/ssl/src/ssl_dist_admin_sup.erl
@@ -0,0 +1,74 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016-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(ssl_dist_admin_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+ PEMCache = pem_cache_child_spec(),
+ SessionCertManager = session_and_cert_manager_child_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+pem_cache_child_spec() ->
+ Name = ssl_pem_cache_dist,
+ StartFunc = {ssl_pem_cache, start_link_dist, [[]]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_pem_cache],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+session_and_cert_manager_child_spec() ->
+ Opts = ssl_admin_sup:manager_opts(),
+ Name = ssl_dist_manager,
+ StartFunc = {ssl_manager, start_link_dist, [Opts]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_manager],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
diff --git a/lib/ssl/src/ssl_dist_connection_sup.erl b/lib/ssl/src/ssl_dist_connection_sup.erl
new file mode 100644
index 0000000000..e5842c866e
--- /dev/null
+++ b/lib/ssl/src/ssl_dist_connection_sup.erl
@@ -0,0 +1,79 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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(ssl_dist_connection_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+
+ TLSConnetionManager = tls_connection_manager_child_spec(),
+ %% Handles emulated options so that they inherited by the accept
+ %% socket, even when setopts is performed on the listen socket
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
+
+ {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager,
+ ListenOptionsTracker
+ ]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+tls_connection_manager_child_spec() ->
+ Name = dist_tls_connection,
+ StartFunc = {tls_connection_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = dist_tls_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
index d47cd76bf5..690b896919 100644
--- a/lib/ssl/src/ssl_dist_sup.erl
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -44,34 +44,29 @@ start_link() ->
%%%=========================================================================
init([]) ->
- SessionCertManager = session_and_cert_manager_child_spec(),
- ConnetionManager = connection_manager_child_spec(),
- ListenOptionsTracker = listen_options_tracker_child_spec(),
+ AdminSup = ssl_admin_child_spec(),
+ ConnectionSup = ssl_connection_sup(),
ProxyServer = proxy_server_child_spec(),
-
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
- ListenOptionsTracker,
- ProxyServer]}}.
+ {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}.
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-session_and_cert_manager_child_spec() ->
- Opts = ssl_sup:manager_opts(),
- Name = ssl_manager_dist,
- StartFunc = {ssl_manager, start_link_dist, [Opts]},
+ssl_admin_child_spec() ->
+ Name = ssl_dist_admin_sup,
+ StartFunc = {ssl_dist_admin_sup, start_link , []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_manager],
- Type = worker,
+ Modules = [ssl_admin_sup],
+ Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-connection_manager_child_spec() ->
- Name = ssl_connection_dist,
- StartFunc = {tls_connection_sup, start_link_dist, []},
- Restart = permanent,
- Shutdown = infinity,
- Modules = [tls_connection_sup],
+ssl_connection_sup() ->
+ Name = ssl_dist_connection_sup,
+ StartFunc = {ssl_dist_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -83,12 +78,3 @@ proxy_server_child_spec() ->
Modules = [ssl_tls_dist_proxy],
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-listen_options_tracker_child_spec() ->
- Name = tls_socket_dist,
- StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_socket],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 4acc745c5f..cb61c82334 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -397,14 +397,13 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature,
%%--------------------------------------------------------------------
certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
MaxPathLen, _Verify, ValidationFunAndState0, PartialChain, CRLCheck, CRLDbHandle, Role) ->
- [PeerCert | _] = ASN1Certs,
-
- ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role,
- CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle),
-
+ [PeerCert | _] = ASN1Certs,
try
{TrustedCert, CertPath} =
ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, PartialChain),
+ ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role,
+ CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath),
case public_key:pkix_path_validation(TrustedCert,
CertPath,
[{max_path_length, MaxPathLen},
@@ -1541,7 +1540,8 @@ sni1(Hostname) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) ->
+validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath) ->
{fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) ->
case ssl_certificate:validate(OtpCert,
Extension,
@@ -1550,22 +1550,25 @@ validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLC
{valid, {NewSslState, UserState}};
{fail, Reason} ->
apply_user_fun(Fun, OtpCert, Reason, UserState,
- SslState);
+ SslState, CertPath);
{unknown, _} ->
apply_user_fun(Fun, OtpCert,
- Extension, UserState, SslState)
+ Extension, UserState, SslState, CertPath)
end;
(OtpCert, VerifyResult, {SslState, UserState}) ->
apply_user_fun(Fun, OtpCert, VerifyResult, UserState,
- SslState)
+ SslState, CertPath)
end, {{Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}, UserState0}};
-validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) ->
+validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath) ->
{fun(OtpCert, {extension, _} = Extension, SslState) ->
ssl_certificate:validate(OtpCert,
Extension,
SslState);
- (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or (VerifyResult == valid_peer) ->
- case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of
+ (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or
+ (VerifyResult == valid_peer) ->
+ case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef,
+ CRLDbHandle, VerifyResult, CertPath) of
valid ->
{VerifyResult, SslState};
Reason ->
@@ -1578,20 +1581,21 @@ validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRL
end, {Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}}.
apply_user_fun(Fun, OtpCert, VerifyResult, UserState0,
- {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState) when
+ {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState, CertPath) when
(VerifyResult == valid) or (VerifyResult == valid_peer) ->
case Fun(OtpCert, VerifyResult, UserState0) of
{Valid, UserState} when (Valid == valid) or (Valid == valid_peer) ->
- case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of
+ case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef,
+ CRLDbHandle, VerifyResult, CertPath) of
valid ->
{Valid, {SslState, UserState}};
Result ->
- apply_user_fun(Fun, OtpCert, Result, UserState, SslState)
+ apply_user_fun(Fun, OtpCert, Result, UserState, SslState, CertPath)
end;
{fail, _} = Fail ->
Fail
end;
-apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) ->
+apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState, _CertPath) ->
case Fun(OtpCert, ExtensionOrError, UserState0) of
{Valid, UserState} when (Valid == valid) or (Valid == valid_peer)->
{Valid, {SslState, UserState}};
@@ -2187,13 +2191,14 @@ handle_psk_identity(_PSKIdentity, LookupFun)
handle_psk_identity(PSKIdentity, {Fun, UserState}) ->
Fun(psk, PSKIdentity, UserState).
-crl_check(_, false, _,_,_, _) ->
+crl_check(_, false, _,_,_, _, _) ->
valid;
-crl_check(_, peer, _, _,_, valid) -> %% Do not check CAs with this option.
+crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option.
valid;
-crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) ->
+crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) ->
Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) ->
- ssl_crl:trusted_cert_and_path(CRL, Issuer, DBInfo)
+ ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
+ DBInfo})
end, {CertDbHandle, CertDbRef}}},
{update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}
],
@@ -2229,7 +2234,8 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) ->
no_dps;
DistPoints ->
Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer,
- distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle)
+ CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle),
+ dps_and_crls(DistPoints, CRLs, [])
end;
dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
@@ -2242,7 +2248,13 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
end, GenNames),
[{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs].
-distpoints_lookup([], _, _, _) ->
+dps_and_crls([], _, Acc) ->
+ Acc;
+dps_and_crls([DP | Rest], CRLs, Acc) ->
+ DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs],
+ dps_and_crls(Rest, CRLs, DpCRL ++ Acc).
+
+distpoints_lookup([],_, _, _) ->
[];
distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
Result =
@@ -2257,7 +2269,7 @@ distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
not_available ->
distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle);
CRLs ->
- [{DistPoint, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]
+ CRLs
end.
sign_algo(?rsaEncryption) ->
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..c10ec3a2d6 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -76,7 +76,7 @@
-define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]).
-define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]).
-define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]).
--define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]).
+-define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]).
-define('24H_in_msec', 86400000).
-define('24H_in_sec', 86400).
@@ -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/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 5bd9521de7..2b82f18bb5 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -32,10 +32,9 @@
new_session_id/1, clean_cert_db/2,
register_session/2, register_session/3, invalidate_session/2,
insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2,
- invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]).
+ invalidate_session/3, name/1]).
-% Spawn export
--export([init_session_validator/1, init_pem_cache_validator/1]).
+-export([init_session_validator/1]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -52,9 +51,7 @@
session_lifetime :: integer(),
certificate_db :: db_handle(),
session_validation_timer :: reference(),
- last_delay_timer = {undefined, undefined},%% Keep for testing purposes
- last_pem_check :: erlang:timestamp(),
- clear_pem_cache :: integer(),
+ last_delay_timer = {undefined, undefined},%% Keep for testing purposes
session_cache_client_max :: integer(),
session_cache_server_max :: integer(),
session_server_invalidator :: undefined | pid(),
@@ -63,7 +60,6 @@
-define(GEN_UNIQUE_ID_MAX_TRIES, 10).
-define(SESSION_VALIDATION_INTERVAL, 60000).
--define(CLEAR_PEM_CACHE, 120000).
-define(CLEAN_SESSION_DB, 60000).
-define(CLEAN_CERT_DB, 500).
-define(DEFAULT_MAX_SESSION_CACHE, 1000).
@@ -74,14 +70,14 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec manager_name(normal | dist) -> atom().
+-spec name(normal | dist) -> atom().
%%
%% Description: Returns the registered name of the ssl manager process
%% in the operation modes 'normal' and 'dist'.
%%--------------------------------------------------------------------
-manager_name(normal) ->
+name(normal) ->
?MODULE;
-manager_name(dist) ->
+name(dist) ->
list_to_atom(atom_to_list(?MODULE) ++ "dist").
%%--------------------------------------------------------------------
@@ -91,9 +87,10 @@ manager_name(dist) ->
%% and certificate caching.
%%--------------------------------------------------------------------
start_link(Opts) ->
- DistMangerName = manager_name(normal),
- gen_server:start_link({local, DistMangerName},
- ?MODULE, [DistMangerName, Opts], []).
+ MangerName = name(normal),
+ CacheName = ssl_pem_cache:name(normal),
+ gen_server:start_link({local, MangerName},
+ ?MODULE, [MangerName, CacheName, Opts], []).
%%--------------------------------------------------------------------
-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
@@ -102,38 +99,23 @@ start_link(Opts) ->
%% be used by the erlang distribution. Note disables soft upgrade!
%%--------------------------------------------------------------------
start_link_dist(Opts) ->
- DistMangerName = manager_name(dist),
+ DistMangerName = name(dist),
+ DistCacheName = ssl_pem_cache:name(dist),
gen_server:start_link({local, DistMangerName},
- ?MODULE, [DistMangerName, Opts], []).
+ ?MODULE, [DistMangerName, DistCacheName, Opts], []).
%%--------------------------------------------------------------------
-spec connection_init(binary()| {der, list()}, client | server,
{Cb :: atom(), Handle:: term()}) ->
- {ok, certdb_ref(), db_handle(), db_handle(),
- db_handle(), db_handle(), CRLInfo::term()}.
+ {ok, map()}.
%%
%% Description: Do necessary initializations for a new connection.
%%--------------------------------------------------------------------
connection_init({der, _} = Trustedcerts, Role, CRLCache) ->
- case bypass_pem_cache() of
- true ->
- {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
- call({connection_init, Extracted, Role, CRLCache});
- false ->
- call({connection_init, Trustedcerts, Role, CRLCache})
- end;
-
-connection_init(<<>> = Trustedcerts, Role, CRLCache) ->
- call({connection_init, Trustedcerts, Role, CRLCache});
-
+ {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
+ call({connection_init, Extracted, Role, CRLCache});
connection_init(Trustedcerts, Role, CRLCache) ->
- case bypass_pem_cache() of
- true ->
- {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
- call({connection_init, Extracted, Role, CRLCache});
- false ->
- call({connection_init, Trustedcerts, Role, CRLCache})
- end.
+ call({connection_init, Trustedcerts, Role, CRLCache}).
%%--------------------------------------------------------------------
-spec cache_pem_file(binary(), term()) -> {ok, term()} | {error, reason()}.
@@ -141,31 +123,14 @@ connection_init(Trustedcerts, Role, CRLCache) ->
%% Description: Cache a pem file and return its content.
%%--------------------------------------------------------------------
cache_pem_file(File, DbHandle) ->
- case bypass_pem_cache() of
- true ->
- ssl_pkix_db:decode_pem_file(File);
- false ->
- case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of
- [{Content,_}] ->
- {ok, Content};
- [Content] ->
- {ok, Content};
- undefined ->
- call({cache_pem, File})
- end
+ case ssl_pkix_db:lookup(File, DbHandle) of
+ [Content] ->
+ {ok, Content};
+ undefined ->
+ ssl_pem_cache:insert(File)
end.
%%--------------------------------------------------------------------
--spec clear_pem_cache() -> ok.
-%%
-%% Description: Clear the PEM cache
-%%--------------------------------------------------------------------
-clear_pem_cache() ->
- %% Not supported for distribution at the moement, should it be?
- put(ssl_manager, manager_name(normal)),
- call(unconditionally_clear_pem_cache).
-
-%%--------------------------------------------------------------------
-spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) ->
undefined |
{ok, {der_cert(), #'OTPCertificate'{}}}.
@@ -222,26 +187,22 @@ invalidate_session(Port, Session) ->
load_mitigation(),
cast({invalidate_session, Port, Session}).
--spec invalidate_pem(File::binary()) -> ok.
-invalidate_pem(File) ->
- cast({invalidate_pem, File}).
-
insert_crls(Path, CRLs)->
insert_crls(Path, CRLs, normal).
insert_crls(?NO_DIST_POINT_PATH = Path, CRLs, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
cast({insert_crls, Path, CRLs});
insert_crls(Path, CRLs, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
call({insert_crls, Path, CRLs}).
delete_crls(Path)->
delete_crls(Path, normal).
delete_crls(?NO_DIST_POINT_PATH = Path, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
cast({delete_crls, Path});
delete_crls(Path, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
call({delete_crls, Path}).
%%====================================================================
@@ -255,13 +216,14 @@ delete_crls(Path, ManagerType)->
%%
%% Description: Initiates the server
%%--------------------------------------------------------------------
-init([Name, Opts]) ->
- put(ssl_manager, Name),
+init([ManagerName, PemCacheName, Opts]) ->
+ put(ssl_manager, ManagerName),
+ put(ssl_pem_cache, PemCacheName),
process_flag(trap_exit, true),
CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache),
SessionLifeTime =
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
- CertDb = ssl_pkix_db:create(),
+ CertDb = ssl_pkix_db:create(PemCacheName),
ClientSessionCache =
CacheCb:init([{role, client} |
proplists:get_value(session_cb_init_args, Opts, [])]),
@@ -270,16 +232,12 @@ init([Name, Opts]) ->
proplists:get_value(session_cb_init_args, Opts, [])]),
Timer = erlang:send_after(SessionLifeTime * 1000 + 5000,
self(), validate_sessions),
- Interval = pem_check_interval(),
- erlang:send_after(Interval, self(), clear_pem_cache),
{ok, #state{certificate_db = CertDb,
session_cache_client = ClientSessionCache,
session_cache_server = ServerSessionCache,
session_cache_cb = CacheCb,
session_lifetime = SessionLifeTime,
session_validation_timer = Timer,
- last_pem_check = os:timestamp(),
- clear_pem_cache = Interval,
session_cache_client_max =
max_session_cache_size(session_cache_client_max),
session_cache_server_max =
@@ -302,18 +260,25 @@ init([Name, Opts]) ->
handle_call({{connection_init, <<>>, Role, {CRLCb, UserCRLDb}}, _Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) ->
Ref = make_ref(),
- Result = {ok, Ref, CertDb, FileRefDb, PemChace,
- session_cache(Role, State), {CRLCb, crl_db_info(Db, UserCRLDb)}},
- {reply, Result, State#state{certificate_db = Db}};
+ {reply, {ok, #{cert_db_ref => Ref,
+ cert_db_handle => CertDb,
+ fileref_db_handle => FileRefDb,
+ pem_cache => PemChace,
+ session_cache => session_cache(Role, State),
+ crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State};
handle_call({{connection_init, Trustedcerts, Role, {CRLCb, UserCRLDb}}, Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) ->
case add_trusted_certs(Pid, Trustedcerts, Db) of
{ok, Ref} ->
- {reply, {ok, Ref, CertDb, FileRefDb, PemChace, session_cache(Role, State),
- {CRLCb, crl_db_info(Db, UserCRLDb)}}, State};
- {error, _} = Error ->
- {reply, Error, State}
+ {reply, {ok, #{cert_db_ref => Ref,
+ cert_db_handle => CertDb,
+ fileref_db_handle => FileRefDb,
+ pem_cache => PemChace,
+ session_cache => session_cache(Role, State),
+ crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State};
+ {error, _} = Error ->
+ {reply, Error, State}
end;
handle_call({{insert_crls, Path, CRLs}, _}, _From,
@@ -330,21 +295,7 @@ handle_call({{new_session_id, Port}, _},
_, #state{session_cache_cb = CacheCb,
session_cache_server = Cache} = State) ->
Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb),
- {reply, Id, State};
-
-handle_call({{cache_pem,File}, _Pid}, _,
- #state{certificate_db = Db} = State) ->
- try ssl_pkix_db:cache_pem_file(File, Db) of
- Result ->
- {reply, Result, State}
- catch
- _:Reason ->
- {reply, {error, Reason}, State}
- end;
-handle_call({unconditionally_clear_pem_cache, _},_,
- #state{certificate_db = [_,_,PemChace | _]} = State) ->
- ssl_pkix_db:clear(PemChace),
- {reply, ok, State}.
+ {reply, Id, State}.
%%--------------------------------------------------------------------
-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}.
@@ -382,11 +333,6 @@ handle_cast({insert_crls, Path, CRLs},
handle_cast({delete_crls, CRLsOrPath},
#state{certificate_db = Db} = State) ->
ssl_pkix_db:remove_crls(Db, CRLsOrPath),
- {noreply, State};
-
-handle_cast({invalidate_pem, File},
- #state{certificate_db = [_, _, PemCache | _]} = State) ->
- ssl_pkix_db:remove(File, PemCache),
{noreply, State}.
%%--------------------------------------------------------------------
@@ -418,22 +364,14 @@ handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = Cache
CacheCb:delete(Cache, Key),
{noreply, State};
-handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace | _],
- clear_pem_cache = Interval,
- last_pem_check = CheckPoint} = State) ->
- NewCheckPoint = os:timestamp(),
- start_pem_cache_validator(PemChace, CheckPoint),
- erlang:send_after(Interval, self(), clear_pem_cache),
- {noreply, State#state{last_pem_check = NewCheckPoint}};
-
handle_info({clean_cert_db, Ref, File},
- #state{certificate_db = [CertDb,RefDb, PemCache | _]} = State) ->
+ #state{certificate_db = [CertDb, {RefDb, FileMapDb} | _]} = State) ->
case ssl_pkix_db:lookup(Ref, RefDb) of
undefined -> %% Alredy cleaned
ok;
_ ->
- clean_cert_db(Ref, CertDb, RefDb, PemCache, File)
+ clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File)
end,
{noreply, State};
@@ -523,14 +461,6 @@ delay_time() ->
?CLEAN_SESSION_DB
end.
-bypass_pem_cache() ->
- case application:get_env(ssl, bypass_pem_cache) of
- {ok, Bool} when is_boolean(Bool) ->
- Bool;
- _ ->
- false
- end.
-
max_session_cache_size(CacheType) ->
case application:get_env(ssl, CacheType) of
{ok, Size} when is_integer(Size) ->
@@ -594,16 +524,11 @@ new_id(Port, Tries, Cache, CacheCb) ->
new_id(Port, Tries - 1, Cache, CacheCb)
end.
-clean_cert_db(Ref, CertDb, RefDb, PemCache, File) ->
+clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) ->
case ssl_pkix_db:ref_count(Ref, RefDb, 0) of
0 ->
- case ssl_pkix_db:lookup_cached_pem(PemCache, File) of
- [{Content, Ref}] ->
- ssl_pkix_db:insert(File, Content, PemCache);
- _ ->
- ok
- end,
ssl_pkix_db:remove(Ref, RefDb),
+ ssl_pkix_db:remove(File, FileMapDb),
ssl_pkix_db:remove_trusted_certs(Ref, CertDb);
_ ->
ok
@@ -687,42 +612,6 @@ exists_equivalent(#session{
exists_equivalent(Session, [ _ | Rest]) ->
exists_equivalent(Session, Rest).
-start_pem_cache_validator(PemCache, CheckPoint) ->
- spawn_link(?MODULE, init_pem_cache_validator,
- [[get(ssl_manager), PemCache, CheckPoint]]).
-
-init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) ->
- put(ssl_manager, SslManagerName),
- ssl_pkix_db:foldl(fun pem_cache_validate/2,
- CheckPoint, PemCache).
-
-pem_cache_validate({File, _}, CheckPoint) ->
- case file:read_file_info(File, []) of
- {ok, #file_info{mtime = Time}} ->
- case is_before_checkpoint(Time, CheckPoint) of
- true ->
- ok;
- false ->
- invalidate_pem(File)
- end;
- _ ->
- invalidate_pem(File)
- end,
- CheckPoint.
-
-pem_check_interval() ->
- case application:get_env(ssl, ssl_pem_cache_clean) of
- {ok, Interval} when is_integer(Interval) ->
- Interval;
- _ ->
- ?CLEAR_PEM_CACHE
- end.
-
-is_before_checkpoint(Time, CheckPoint) ->
- calendar:datetime_to_gregorian_seconds(
- calendar:now_to_datetime(CheckPoint)) -
- calendar:datetime_to_gregorian_seconds(Time) > 0.
-
add_trusted_certs(Pid, Trustedcerts, Db) ->
try
ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db)
diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl
new file mode 100644
index 0000000000..f63a301f69
--- /dev/null
+++ b/lib/ssl/src/ssl_pem_cache.erl
@@ -0,0 +1,266 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 20016-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%
+%%
+
+%%----------------------------------------------------------------------
+%% Purpose: Manages ssl sessions and trusted certifacates
+%%----------------------------------------------------------------------
+
+-module(ssl_pem_cache).
+-behaviour(gen_server).
+
+%% Internal application API
+-export([start_link/1,
+ start_link_dist/1,
+ name/1,
+ insert/1,
+ clear/0]).
+
+% Spawn export
+-export([init_pem_cache_validator/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-include("ssl_handshake.hrl").
+-include("ssl_internal.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-record(state, {
+ pem_cache,
+ last_pem_check :: erlang:timestamp(),
+ clear :: integer()
+ }).
+
+-define(CLEAR_PEM_CACHE, 120000).
+-define(DEFAULT_MAX_SESSION_CACHE, 1000).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec name(normal | dist) -> atom().
+%%
+%% Description: Returns the registered name of the ssl cache process
+%% in the operation modes 'normal' and 'dist'.
+%%--------------------------------------------------------------------
+name(normal) ->
+ ?MODULE;
+name(dist) ->
+ list_to_atom(atom_to_list(?MODULE) ++ "dist").
+
+%%--------------------------------------------------------------------
+-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts the ssl pem cache handler
+%%--------------------------------------------------------------------
+start_link(_) ->
+ CacheName = name(normal),
+ gen_server:start_link({local, CacheName},
+ ?MODULE, [CacheName], []).
+
+%%--------------------------------------------------------------------
+-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts a special instance of the ssl manager to
+%% be used by the erlang distribution. Note disables soft upgrade!
+%%--------------------------------------------------------------------
+start_link_dist(_) ->
+ DistCacheName = name(dist),
+ gen_server:start_link({local, DistCacheName},
+ ?MODULE, [DistCacheName], []).
+
+
+%%--------------------------------------------------------------------
+-spec insert(binary()) -> {ok, term()} | {error, reason()}.
+%%
+%% Description: Cache a pem file and return its content.
+%%--------------------------------------------------------------------
+insert(File) ->
+ {ok, PemBin} = file:read_file(File),
+ Content = public_key:pem_decode(PemBin),
+ case bypass_cache() of
+ true ->
+ {ok, Content};
+ false ->
+ cast({cache_pem, File, Content}),
+ {ok, Content}
+ end.
+
+%%--------------------------------------------------------------------
+-spec clear() -> ok.
+%%
+%% Description: Clear the PEM cache
+%%--------------------------------------------------------------------
+clear() ->
+ %% Not supported for distribution at the moement, should it be?
+ put(ssl_pem_cache, name(normal)),
+ call(unconditionally_clear_pem_cache).
+
+-spec invalidate_pem(File::binary()) -> ok.
+invalidate_pem(File) ->
+ cast({invalidate_pem, File}).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec init(list()) -> {ok, #state{}}.
+%% Possible return values not used now.
+%% | {ok, #state{}, timeout()} | ignore | {stop, term()}.
+%%
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([Name]) ->
+ put(ssl_pem_cache, Name),
+ process_flag(trap_exit, true),
+ PemCache = ssl_pkix_db:create_pem_cache(Name),
+ Interval = pem_check_interval(),
+ erlang:send_after(Interval, self(), clear_pem_cache),
+ {ok, #state{pem_cache = PemCache,
+ last_pem_check = os:timestamp(),
+ clear = Interval
+ }}.
+
+%%--------------------------------------------------------------------
+-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}.
+%% Possible return values not used now.
+%% {reply, reply(), #state{}, timeout()} |
+%% {noreply, #state{}} |
+%% {noreply, #state{}, timeout()} |
+%% {stop, reason(), reply(), #state{}} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call({unconditionally_clear_pem_cache, _},_,
+ #state{pem_cache = PemCache} = State) ->
+ ssl_pkix_db:clear(PemCache),
+ {reply, ok, State}.
+
+%%--------------------------------------------------------------------
+-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% | {noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast({cache_pem, File, Content}, #state{pem_cache = Db} = State) ->
+ ssl_pkix_db:insert(File, Content, Db),
+ {noreply, State};
+
+handle_cast({invalidate_pem, File}, #state{pem_cache = Db} = State) ->
+ ssl_pkix_db:remove(File, Db),
+ {noreply, State}.
+
+
+%%--------------------------------------------------------------------
+-spec handle_info(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% |{noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling all non call/cast messages
+%%-------------------------------------------------------------------
+handle_info(clear_pem_cache, #state{pem_cache = PemCache,
+ clear = Interval,
+ last_pem_check = CheckPoint} = State) ->
+ NewCheckPoint = os:timestamp(),
+ start_pem_cache_validator(PemCache, CheckPoint),
+ erlang:send_after(Interval, self(), clear_pem_cache),
+ {noreply, State#state{last_pem_check = NewCheckPoint}};
+
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+-spec terminate(reason(), #state{}) -> ok.
+%%
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, #state{}) ->
+ ok.
+
+%%--------------------------------------------------------------------
+-spec code_change(term(), #state{}, list()) -> {ok, #state{}}.
+%%
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+call(Msg) ->
+ gen_server:call(get(ssl_pem_cache), {Msg, self()}, infinity).
+
+cast(Msg) ->
+ gen_server:cast(get(ssl_pem_cache), Msg).
+
+start_pem_cache_validator(PemCache, CheckPoint) ->
+ spawn_link(?MODULE, init_pem_cache_validator,
+ [[get(ssl_pem_cache), PemCache, CheckPoint]]).
+
+init_pem_cache_validator([CacheName, PemCache, CheckPoint]) ->
+ put(ssl_pem_cache, CacheName),
+ ssl_pkix_db:foldl(fun pem_cache_validate/2,
+ CheckPoint, PemCache).
+
+pem_cache_validate({File, _}, CheckPoint) ->
+ case file:read_file_info(File, []) of
+ {ok, #file_info{mtime = Time}} ->
+ case is_before_checkpoint(Time, CheckPoint) of
+ true ->
+ ok;
+ false ->
+ invalidate_pem(File)
+ end;
+ _ ->
+ invalidate_pem(File)
+ end,
+ CheckPoint.
+
+is_before_checkpoint(Time, CheckPoint) ->
+ calendar:datetime_to_gregorian_seconds(
+ calendar:now_to_datetime(CheckPoint)) -
+ calendar:datetime_to_gregorian_seconds(Time) > 0.
+
+pem_check_interval() ->
+ case application:get_env(ssl, ssl_pem_cache_clean) of
+ {ok, Interval} when is_integer(Interval) ->
+ Interval;
+ _ ->
+ ?CLEAR_PEM_CACHE
+ end.
+
+bypass_cache() ->
+ case application:get_env(ssl, bypass_pem_cache) of
+ {ok, Bool} when is_boolean(Bool) ->
+ Bool;
+ _ ->
+ false
+ end.
diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl
index b4299969e4..cde05bb16f 100644
--- a/lib/ssl/src/ssl_pkix_db.erl
+++ b/lib/ssl/src/ssl_pkix_db.erl
@@ -28,11 +28,11 @@
-include_lib("public_key/include/public_key.hrl").
-include_lib("kernel/include/file.hrl").
--export([create/0, add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3,
+-export([create/1, create_pem_cache/1,
+ add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3,
extract_trusted_certs/1,
remove_trusted_certs/2, insert/3, remove/2, clear/1, db_size/1,
ref_count/3, lookup_trusted_cert/4, foldl/3, select_cert_by_issuer/2,
- lookup_cached_pem/2, cache_pem_file/2, cache_pem_file/3,
decode_pem_file/1, lookup/2]).
%%====================================================================
@@ -40,25 +40,31 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec create() -> [db_handle(),...].
+-spec create(atom()) -> [db_handle(),...].
%%
%% Description: Creates a new certificate db.
%% Note: lookup_trusted_cert/4 may be called from any process but only
%% the process that called create may call the other functions.
%%--------------------------------------------------------------------
-create() ->
+create(PEMCacheName) ->
[%% Let connection process delete trusted certs
%% that can only belong to one connection. (Supplied directly
%% on DER format to ssl:connect/listen.)
ets:new(ssl_otp_cacertificate_db, [set, public]),
%% Let connection processes call ref_count/3 directly
- ets:new(ssl_otp_ca_file_ref, [set, public]),
- ets:new(ssl_otp_pem_cache, [set, protected]),
+ {ets:new(ssl_otp_ca_file_ref, [set, public]),
+ ets:new(ssl_otp_ca_ref_file_mapping, [set, protected])
+ },
+ %% Lookups in named table owned by ssl_pem_cache process
+ PEMCacheName,
%% Default cache
{ets:new(ssl_otp_crl_cache, [set, protected]),
ets:new(ssl_otp_crl_issuer_mapping, [bag, protected])}
].
+create_pem_cache(Name) ->
+ ets:new(Name, [named_table, set, protected]).
+
%%--------------------------------------------------------------------
-spec remove([db_handle()]) -> ok.
%%
@@ -70,6 +76,10 @@ remove(Dbs) ->
true = ets:delete(Db1);
(undefined) ->
ok;
+ (ssl_pem_cache) ->
+ ok;
+ (ssl_pem_cache_dist) ->
+ ok;
(Db) ->
true = ets:delete(Db)
end, Dbs).
@@ -101,11 +111,6 @@ lookup_trusted_cert(_DbHandle, {extracted,Certs}, SerialNumber, Issuer) ->
{ok, Cert}
end.
-lookup_cached_pem([_, _, PemChache | _], File) ->
- lookup_cached_pem(PemChache, File);
-lookup_cached_pem(PemChache, File) ->
- lookup(File, PemChache).
-
%%--------------------------------------------------------------------
-spec add_trusted_certs(pid(), {erlang:timestamp(), string()} |
{der, list()}, [db_handle()]) -> {ok, [db_handle()]}.
@@ -122,17 +127,11 @@ add_trusted_certs(_Pid, {der, DerList}, [CertDb, _,_ | _]) ->
add_certs_from_der(DerList, NewRef, CertDb),
{ok, NewRef};
-add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache | _] = Db) ->
- case lookup_cached_pem(Db, File) of
- [{_Content, Ref}] ->
+add_trusted_certs(_Pid, File, [ _, {RefDb, FileMapDb} | _] = Db) ->
+ case lookup(File, FileMapDb) of
+ [Ref] ->
ref_count(Ref, RefDb, 1),
{ok, Ref};
- [Content] ->
- Ref = make_ref(),
- update_counter(Ref, 1, RefDb),
- insert(File, {Content, Ref}, PemChache),
- add_certs_from_pem(Content, Ref, CertsDb),
- {ok, Ref};
undefined ->
new_trusted_cert_entry(File, Db)
end.
@@ -151,25 +150,6 @@ extract_trusted_certs(File) ->
{error, {badmatch, Error}}
end.
-%%--------------------------------------------------------------------
-%%
-%% Description: Cache file as binary in DB
-%%--------------------------------------------------------------------
--spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}.
-cache_pem_file(File, [_CertsDb, _RefDb, PemChache | _]) ->
- {ok, PemBin} = file:read_file(File),
- Content = public_key:pem_decode(PemBin),
- insert(File, Content, PemChache),
- {ok, Content}.
-
-
--spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}.
-cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache| _]) ->
- {ok, PemBin} = file:read_file(File),
- Content = public_key:pem_decode(PemBin),
- insert(File, {Content, Ref}, PemChache),
- {ok, Content}.
-
-spec decode_pem_file(binary()) -> {ok, term()}.
decode_pem_file(File) ->
case file:read_file(File) of
@@ -246,6 +226,8 @@ select_cert_by_issuer(Cache, Issuer) ->
%%--------------------------------------------------------------------
ref_count({extracted, _}, _Db, _N) ->
not_cached;
+ref_count(Key, {Db, _}, N) ->
+ ref_count(Key, Db, N);
ref_count(Key, Db, N) ->
ets:update_counter(Db,Key,N).
@@ -278,9 +260,9 @@ insert(Key, Data, Db) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-update_counter(Key, Count, Db) ->
- true = ets:insert(Db, {Key, Count}),
- ok.
+init_ref_db(Ref, File, {RefDb, FileMapDb}) ->
+ true = ets:insert(RefDb, {Ref, 1}),
+ true = ets:insert(FileMapDb, {File, Ref}).
remove_certs(Ref, CertsDb) ->
true = ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}),
@@ -326,10 +308,10 @@ decode_certs(Ref, Cert) ->
undefined
end.
-new_trusted_cert_entry(File, [CertsDb, RefDb, _ | _] = Db) ->
+new_trusted_cert_entry(File, [CertsDb, RefsDb, _ | _]) ->
Ref = make_ref(),
- update_counter(Ref, 1, RefDb),
- {ok, Content} = cache_pem_file(Ref, File, Db),
+ init_ref_db(Ref, File, RefsDb),
+ {ok, Content} = ssl_pem_cache:insert(File),
add_certs_from_pem(Content, Ref, CertsDb),
{ok, Ref}.
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index 8245801139..05a7aaaa82 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -25,7 +25,7 @@
-behaviour(supervisor).
%% API
--export([start_link/0, manager_opts/0]).
+-export([start_link/0]).
%% Supervisor callback
-export([init/1]).
@@ -44,90 +44,28 @@ start_link() ->
%%%=========================================================================
init([]) ->
- SessionCertManager = session_and_cert_manager_child_spec(),
- TLSConnetionManager = tls_connection_manager_child_spec(),
- %% Handles emulated options so that they inherited by the accept
- %% socket, even when setopts is performed on the listen socket
- ListenOptionsTracker = listen_options_tracker_child_spec(),
-
- DTLSConnetionManager = dtls_connection_manager_child_spec(),
- DTLSUdpListeners = dtls_udp_listeners_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [ssl_admin_child_spec(),
+ ssl_connection_sup()
+ ]}}.
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager,
- ListenOptionsTracker,
- DTLSConnetionManager, DTLSUdpListeners
- ]}}.
-
-
-manager_opts() ->
- CbOpts = case application:get_env(ssl, session_cb) of
- {ok, Cb} when is_atom(Cb) ->
- InitArgs = session_cb_init_args(),
- [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
- _ ->
- []
- end,
- case application:get_env(ssl, session_lifetime) of
- {ok, Time} when is_integer(Time) ->
- [{session_lifetime, Time}| CbOpts];
- _ ->
- CbOpts
- end.
-
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-
-session_and_cert_manager_child_spec() ->
- Opts = manager_opts(),
- Name = ssl_manager,
- StartFunc = {ssl_manager, start_link, [Opts]},
+ssl_admin_child_spec() ->
+ Name = ssl_admin_sup,
+ StartFunc = {ssl_admin_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_manager],
- Type = worker,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-tls_connection_manager_child_spec() ->
- Name = tls_connection,
- StartFunc = {tls_connection_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_connection_sup],
+ Modules = [ssl_admin_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-dtls_connection_manager_child_spec() ->
- Name = dtls_connection,
- StartFunc = {dtls_connection_sup, start_link, []},
+ssl_connection_sup() ->
+ Name = ssl_connection_sup,
+ StartFunc = {ssl_connection_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [dtls_connection_sup],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-listen_options_tracker_child_spec() ->
- Name = tls_socket,
- StartFunc = {ssl_listen_tracker_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_socket],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-dtls_udp_listeners_spec() ->
- Name = dtls_udp_listener,
- StartFunc = {dtls_udp_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [],
+ Modules = [ssl_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-session_cb_init_args() ->
- case application:get_env(ssl, session_cb_init_args) of
- {ok, Args} when is_list(Args) ->
- Args;
- _ ->
- []
- end.
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 32991d3079..c6e530e164 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -48,7 +48,7 @@
-export([encode_data/3, encode_alert/3]).
%% State transition handling
--export([next_record/1, next_event/3]).
+-export([next_record/1, next_event/3, next_event/4]).
%% Handshake handling
-export([renegotiate/2, send_handshake/2,
@@ -59,7 +59,8 @@
-export([send_alert/2, close/5]).
%% Data handling
--export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3]).
+-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3,
+ socket/5]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -117,7 +118,7 @@ send_handshake_flight(#state{socket = Socket,
transport_cb = Transport,
flight_buffer = Flight} = State0) ->
send(Transport, Socket, Flight),
- State0#state{flight_buffer = []}.
+ {State0#state{flight_buffer = []}, []}.
queue_change_cipher(Msg, #state{negotiated_version = Version,
flight_buffer = Flight0,
@@ -191,6 +192,10 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
callback_mode() ->
state_functions.
+socket(Pid, Transport, Socket, Connection, Tracker) ->
+ tls_socket:socket(Pid, Transport, Socket, Connection, Tracker).
+
+
%%--------------------------------------------------------------------
%% State functions
%%--------------------------------------------------------------------
@@ -340,12 +345,12 @@ connection(internal, #hello_request{},
renegotiation = {Renegotiation, _}} = State0) ->
Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
- State1 = send_handshake(Hello, State0),
+ {State1, Actions} = send_handshake(Hello, State0),
{Record, State} =
next_record(
State1#state{session = Session0#session{session_id
= Hello#client_hello.session_id}}),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
connection(internal, #client_hello{} = Hello,
#state{role = server, allow_renegotiate = true} = State0) ->
%% Mitigate Computational DoS attack
@@ -424,18 +429,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 +628,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 +746,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/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 2800ee6537..f4803ce19f 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -192,7 +192,8 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId,
end.
get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
- Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
+ Body:Length/binary,Rest/binary>>,
+ #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
try decode_handshake(Version, Type, Body, V2Hello) of
Handshake ->
@@ -207,27 +208,17 @@ get_tls_handshake_aux(_Version, Data, _, Acc) ->
decode_handshake(_, ?HELLO_REQUEST, <<>>, _) ->
#hello_request{};
-%% Client hello v2.
-%% The server must be able to receive such messages, from clients that
-%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
-decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>, true) ->
- #client_hello{client_version = {Major, Minor},
- random = ssl_v2:client_random(ChallengeData, CDLength),
- session_id = 0,
- cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites),
- compression_methods = [?NULL],
- extensions = #hello_extensions{}
- };
-decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(_), ?BYTE(_),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- _CipherSuites:CSLength/binary,
- _ChallengeData:CDLength/binary>>, false) ->
- throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION, ssl_v2_client_hello_no_supported));
+decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) ->
+ try decode_hello(Bin) of
+ Hello ->
+ Hello
+ catch
+ _:_ ->
+ decode_v2_hello(Bin)
+ end;
+decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) ->
+ decode_hello(Bin);
+
decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
?UINT16(Cs_length), CipherSuites:Cs_length/binary,
@@ -244,10 +235,40 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3
compression_methods = Comp_methods,
extensions = DecodedExtensions
};
-
decode_handshake(Version, Tag, Msg, _) ->
ssl_handshake:decode_handshake(Version, Tag, Msg).
+
+decode_hello(<<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
+ ?BYTE(SID_length), Session_ID:SID_length/binary,
+ ?UINT16(Cs_length), CipherSuites:Cs_length/binary,
+ ?BYTE(Cm_length), Comp_methods:Cm_length/binary,
+ Extensions/binary>>) ->
+ DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}),
+
+ #client_hello{
+ client_version = {Major,Minor},
+ random = Random,
+ session_id = Session_ID,
+ cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites),
+ compression_methods = Comp_methods,
+ extensions = DecodedExtensions
+ }.
+%% The server must be able to receive such messages, from clients that
+%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
+decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor),
+ ?UINT16(CSLength), ?UINT16(0),
+ ?UINT16(CDLength),
+ CipherSuites:CSLength/binary,
+ ChallengeData:CDLength/binary>>) ->
+ #client_hello{client_version = {Major, Minor},
+ random = ssl_v2:client_random(ChallengeData, CDLength),
+ session_id = 0,
+ cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites),
+ compression_methods = [?NULL],
+ extensions = #hello_extensions{}
+ }.
+
enc_handshake(#hello_request{}, _Version) ->
{?HELLO_REQUEST, <<>>};
enc_handshake(#client_hello{client_version = {Major, Minor},
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index 7f24ce5192..32bcdf71c3 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -204,21 +204,21 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
-
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA
+ ?TLS_RSA_WITH_AES_128_CBC_SHA,
+
+ ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
];
suites(3) ->
[
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index d85be6c69e..e14f7f60c4 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -172,8 +172,8 @@ revoke(Root, CA, User, C) ->
gencrl(Root, CA, C).
gencrl(Root, CA, C) ->
- %% By default, the CRL is valid for 24 hours from now.
- gencrl(Root, CA, C, 24).
+ %% By default, the CRL is valid for a week from now.
+ gencrl(Root, CA, C, 24*7).
gencrl(Root, CA, C, CrlHours) ->
CACnfFile = filename:join([Root, CA, "ca.cnf"]),
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 52c1af5b4c..bff6d254f1 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -53,7 +53,8 @@ all() ->
{group, options_tls},
{group, session},
{group, 'dtlsv1.2'},
- %%{group, 'dtlsv1'},
+ %% {group, 'dtlsv1'}, Breaks dtls in cert_verify_SUITE enable later when
+ %% problem is identified and fixed
{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
@@ -65,15 +66,15 @@ groups() ->
{basic_tls, [], basic_tests_tls()},
{options, [], options_tests()},
{options_tls, [], options_tests_tls()},
- %%{'dtlsv1.2', [], all_versions_groups()},
- {'dtlsv1.2', [], [connection_information]},
- %%{'dtlsv1', [], all_versions_groups()},
+ {'dtlsv1.2', [], all_versions_groups()},
+ {'dtlsv1', [], all_versions_groups()},
{'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]},
{'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()},
{'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()},
{'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]},
{api,[], api_tests()},
{api_tls,[], api_tests_tls()},
+ {tls_ciphers,[], tls_cipher_tests()},
{session, [], session_tests()},
{renegotiate, [], renegotiate_tests()},
{ciphers, [], cipher_tests()},
@@ -83,12 +84,13 @@ groups() ->
].
tls_versions_groups ()->
- [{group, api_tls},
+ [{group, renegotiate}, %% Should be in all_versions_groups not fixed for DTLS yet
+ {group, api_tls},
+ {group, tls_ciphers},
{group, error_handling_tests_tls}].
all_versions_groups ()->
[{group, api},
- {group, renegotiate},
{group, ciphers},
{group, ciphers_ec},
{group, error_handling_tests}].
@@ -136,7 +138,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() ->
@@ -146,10 +149,8 @@ options_tests_tls() ->
api_tests() ->
[connection_info,
connection_information,
- peername,
peercert,
peercert_with_client_cert,
- sockname,
versions,
eccs,
controlling_process,
@@ -161,7 +162,6 @@ api_tests() ->
ssl_recv_timeout,
server_name_indication_option,
accept_pool,
- new_options_in_accept,
prf
].
@@ -174,7 +174,10 @@ api_tests_tls() ->
tls_shutdown,
tls_shutdown_write,
tls_shutdown_both,
- tls_shutdown_error
+ tls_shutdown_error,
+ peername,
+ sockname,
+ new_options_in_accept
].
session_tests() ->
@@ -196,6 +199,11 @@ renegotiate_tests() ->
renegotiate_dos_mitigate_passive,
renegotiate_dos_mitigate_absolute].
+tls_cipher_tests() ->
+ [rc4_rsa_cipher_suites,
+ rc4_ecdh_rsa_cipher_suites,
+ rc4_ecdsa_cipher_suites].
+
cipher_tests() ->
[cipher_suites,
cipher_suites_mix,
@@ -211,9 +219,6 @@ cipher_tests() ->
srp_cipher_suites,
srp_anon_cipher_suites,
srp_dsa_cipher_suites,
- rc4_rsa_cipher_suites,
- rc4_ecdh_rsa_cipher_suites,
- rc4_ecdsa_cipher_suites,
des_rsa_cipher_suites,
des_ecdh_rsa_cipher_suites,
default_reject_anonymous].
@@ -225,15 +230,15 @@ cipher_tests_ec() ->
ciphers_ecdh_rsa_signed_certs_openssl_names].
error_handling_tests()->
- [controller_dies,
- close_transport_accept,
+ [close_transport_accept,
recv_active,
recv_active_once,
recv_error_handling
].
error_handling_tests_tls()->
- [tls_client_closes_socket,
+ [controller_dies,
+ tls_client_closes_socket,
tls_tcp_error_propagation_in_active_mode,
tls_tcp_connect,
tls_tcp_connect_big,
@@ -842,8 +847,7 @@ controller_dies(Config) when is_list(Config) ->
Server ! listen,
Tester = self(),
Connect = fun(Pid) ->
- {ok, Socket} = ssl:connect(Hostname, Port,
- [{reuseaddr,true},{ssl_imp,new}]),
+ {ok, Socket} = ssl:connect(Hostname, Port, ClientOpts),
%% Make sure server finishes and verification
%% and is in coonection state before
%% killing client
@@ -960,9 +964,9 @@ clear_pem_cache(Config) when is_list(Config) ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- [_,FilRefDb |_] = element(6, State),
+ [_,{FilRefDb, _} |_] = element(6, State),
{Server, Client} = basic_verify_test_no_close(Config),
- CountReferencedFiles = fun({_,-1}, Acc) ->
+ CountReferencedFiles = fun({_, -1}, Acc) ->
Acc;
({_, N}, Acc) ->
N + Acc
@@ -2193,8 +2197,9 @@ ciphers_dsa_signed_certs() ->
[{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:dsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, dsa).
%%-------------------------------------------------------------------
@@ -2217,29 +2222,33 @@ anonymous_cipher_suites(Config) when is_list(Config) ->
psk_cipher_suites() ->
[{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_suites(),
+ Ciphers = ssl_test_lib:psk_suites(NVersion),
run_suites(Ciphers, Version, Config, psk).
%%-------------------------------------------------------------------
psk_with_hint_cipher_suites()->
[{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
psk_with_hint_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_suites(),
+ Ciphers = ssl_test_lib:psk_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_with_hint).
%%-------------------------------------------------------------------
psk_anon_cipher_suites() ->
[{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_anon_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_anon_suites(),
+ Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_anon).
%%-------------------------------------------------------------------
psk_anon_with_hint_cipher_suites()->
[{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_anon_suites(),
+ Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_anon_with_hint).
%%-------------------------------------------------------------------
srp_cipher_suites()->
@@ -2290,18 +2299,17 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
%%-------------------------------------------------------------------
des_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
+ [{doc, "Test the des_rsa ciphersuites"}].
des_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:des_suites(NVersion),
+ Version = ssl_test_lib:protocol_version(Config),
+ Ciphers = ssl_test_lib:des_suites(Config),
run_suites(Ciphers, Version, Config, des_rsa).
%-------------------------------------------------------------------
des_ecdh_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
+ [{doc, "Test ECDH rsa signed ciphersuites"}].
des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(NVersion),
run_suites(Ciphers, Version, Config, des_dhe_rsa).
@@ -2312,9 +2320,11 @@ default_reject_anonymous(Config) when is_list(Config) ->
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()),
- [CipherSuite | _] = ssl_test_lib:anonymous_suites(Version),
-
+ Version = ssl_test_lib:protocol_version(Config),
+ TLSVersion = ssl_test_lib:tls_version(Version),
+
+ [CipherSuite | _] = ssl_test_lib:anonymous_suites(TLSVersion),
+
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
{from, self()},
{options, ServerOpts}]),
@@ -2334,8 +2344,9 @@ ciphers_ecdsa_signed_certs() ->
[{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:ecdsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, ecdsa).
%%--------------------------------------------------------------------
@@ -2352,8 +2363,9 @@ ciphers_ecdh_rsa_signed_certs() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, ecdh_rsa).
%%--------------------------------------------------------------------
@@ -3325,11 +3337,11 @@ hibernate(Config) ->
process_info(Pid, current_function),
ssl_test_lib:check_result(Server, ok, Client, ok),
- timer:sleep(1100),
-
+
+ timer:sleep(1500),
{current_function, {erlang, hibernate, 3}} =
process_info(Pid, current_function),
-
+
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
@@ -3362,13 +3374,12 @@ hibernate_right_away(Config) ->
[{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]),
ssl_test_lib:check_result(Server1, ok, Client1, ok),
-
- {current_function, {erlang, hibernate, 3}} =
+
+ {current_function, {erlang, hibernate, 3}} =
process_info(Pid1, current_function),
-
ssl_test_lib:close(Server1),
ssl_test_lib:close(Client1),
-
+
Server2 = ssl_test_lib:start_server(StartServerOpts),
Port2 = ssl_test_lib:inet_port(Server2),
{Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++
@@ -3376,8 +3387,8 @@ hibernate_right_away(Config) ->
ssl_test_lib:check_result(Server2, ok, Client2, ok),
- ct:sleep(100), %% Schedule out
-
+ ct:sleep(1000), %% Schedule out
+
{current_function, {erlang, hibernate, 3}} =
process_info(Pid2, current_function),
@@ -3860,6 +3871,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."}].
@@ -4483,16 +4517,21 @@ run_suites(Ciphers, Version, Config, Type) ->
[{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]};
psk ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk, Config)};
+ [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk, Config)]};
psk_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_hint, Config)};
+ [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_hint, Config)
+ ]};
psk_anon ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_anon, Config)};
+ [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_anon, Config)]};
psk_anon_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_anon_hint, Config)};
+ [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
srp ->
{ssl_test_lib:ssl_options(client_srp, Config),
ssl_test_lib:ssl_options(server_srp, Config)};
@@ -4532,7 +4571,7 @@ run_suites(Ciphers, Version, Config, Type) ->
Result = lists:map(fun(Cipher) ->
cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
- ssl_test_lib:filter_suites(Ciphers)),
+ ssl_test_lib:filter_suites(Ciphers, Version)),
case lists:flatten(Result) of
[] ->
ok;
diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
index 5265c87e29..4552a4f57d 100644
--- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl
+++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
@@ -39,17 +39,26 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
all() ->
- [{group, active},
- {group, passive},
- {group, active_once},
- {group, error_handling}].
-
+ [
+ {group, tls},
+ {group, dtls}
+ ].
groups() ->
- [{active, [], tests()},
+ [
+ {tls, [], all_protocol_groups()},
+ {dtls, [], all_protocol_groups()},
+ {active, [], tests()},
{active_once, [], tests()},
{passive, [], tests()},
- {error_handling, [],error_handling_tests()}].
+ {error_handling, [],error_handling_tests()}
+ ].
+
+all_protocol_groups() ->
+ [{group, active},
+ {group, passive},
+ {group, active_once},
+ {group, error_handling}].
tests() ->
[verify_peer,
@@ -85,7 +94,7 @@ init_per_suite(Config0) ->
catch crypto:stop(),
try crypto:start() of
ok ->
- ssl_test_lib:clean_start(),
+ ssl_test_lib:clean_start(),
%% make rsa certs using oppenssl
{ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
proplists:get_value(priv_dir, Config0)),
@@ -99,6 +108,26 @@ end_per_suite(_Config) ->
ssl:stop(),
application:stop(crypto).
+init_per_group(tls, Config) ->
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, protocol_version, Version),
+ application:set_env(ssl, bypass_pem_cache, Version),
+ ssl:start(),
+ NewConfig = proplists:delete(protocol, Config),
+ [{protocol, tls}, {version, tls_record:protocol_version(Version)} | NewConfig];
+
+init_per_group(dtls, Config) ->
+ Version = dtls_record:protocol_version(dtls_record:highest_protocol_version([])),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, protocol_version, Version),
+ application:set_env(ssl, bypass_pem_cache, Version),
+ ssl:start(),
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}, {version, dtls_record:protocol_version(Version)} | NewConfig];
+
init_per_group(active, Config) ->
[{active, true}, {receive_function, send_recv_result_active} | Config];
init_per_group(active_once, Config) ->
@@ -262,7 +291,7 @@ server_require_peer_cert_fail() ->
server_require_peer_cert_fail(Config) when is_list(Config) ->
ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}
| ssl_test_lib:ssl_options(server_verification_opts, Config)],
- BadClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ BadClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
@@ -411,7 +440,7 @@ server_require_peer_cert_partial_chain_fun_fail() ->
server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) ->
ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}
| ssl_test_lib:ssl_options(server_verification_opts, Config)],
- ClientOpts = proplists:get_value(client_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
{ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)),
@@ -1091,6 +1120,7 @@ client_with_cert_cipher_suites_handshake() ->
client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_verification_opts_digital_signature_only, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
@@ -1098,7 +1128,7 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
send_recv_result_active, []}},
{options, [{active, true},
{ciphers,
- ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))}
+ ssl_test_lib:rsa_non_signed_suites(proplists:get_value(version, Config))}
| ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
@@ -1132,7 +1162,7 @@ server_verify_no_cacerts(Config) when is_list(Config) ->
unknown_server_ca_fail() ->
[{doc,"Test that the client fails if the ca is unknown in verify_peer mode"}].
unknown_server_ca_fail(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
@@ -1176,7 +1206,7 @@ unknown_server_ca_fail(Config) when is_list(Config) ->
unknown_server_ca_accept_verify_none() ->
[{doc,"Test that the client succeds if the ca is unknown in verify_none mode"}].
unknown_server_ca_accept_verify_none(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1201,8 +1231,8 @@ unknown_server_ca_accept_verify_peer() ->
[{doc, "Test that the client succeds if the ca is unknown in verify_peer mode"
" with a verify_fun that accepts the unknown ca error"}].
unknown_server_ca_accept_verify_peer(Config) when is_list(Config) ->
- ClientOpts =ssl_test_lib:ssl_options(client_opts, []),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
@@ -1240,7 +1270,7 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) ->
unknown_server_ca_accept_backwardscompatibility() ->
[{doc,"Test that old style verify_funs will work"}].
unknown_server_ca_accept_backwardscompatibility(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index 74b14145dd..0a50c98a28 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -33,6 +33,7 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
all() -> [decode_hello_handshake,
+ decode_hello_handshake_version_confusion,
decode_single_hello_extension_correctly,
decode_supported_elliptic_curves_hello_extension_correctly,
decode_unknown_hello_extension_correctly,
@@ -106,6 +107,14 @@ decode_hello_handshake(_Config) ->
#renegotiation_info{renegotiated_connection = <<0>>}
= (Hello#server_hello.extensions)#hello_extensions.renegotiation_info.
+
+decode_hello_handshake_version_confusion(_) ->
+ HelloPacket = <<3,3,0,0,0,0,0,63,210,235,149,6,244,140,108,13,177,74,16,218,33,108,219,41,73,228,3,82,132,123,73,144,118,100,0,0,32,192,4,0,10,192,45,192,38,0,47,192,18,0,163,0,22,0,165,192,29,192,18,192,30,0,103,0,57,192,48,0,47,1,0>>,
+ Version = {3,3},
+ ClientHello = 1,
+ Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, false),
+ Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, true).
+
decode_single_hello_extension_correctly(_Config) ->
Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>,
Extensions = ssl_handshake:decode_hello_extensions(Renegotiation),
diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl
index 69aeea10c5..0b1de1dc1c 100644
--- a/lib/ssl/test/ssl_npn_hello_SUITE.erl
+++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl
@@ -50,6 +50,10 @@ init_per_suite(Config) ->
{skip, "Crypto did not start"}
end.
+end_per_suite(_Config) ->
+ %% This function is required since init_per_suite/1 exists.
+ ok.
+
init_per_testcase(_TestCase, Config) ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
ct:timetrap({seconds, 5}),
diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl
index f10d27fbc6..96b15d9b51 100644
--- a/lib/ssl/test/ssl_pem_cache_SUITE.erl
+++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl
@@ -82,8 +82,8 @@ pem_cleanup() ->
[{doc, "Test pem cache invalidate mechanism"}].
pem_cleanup(Config)when is_list(Config) ->
process_flag(trap_exit, true),
- ClientOpts = proplists:get_value(client_opts, Config),
- ServerOpts = proplists:get_value(server_opts, Config),
+ ClientOpts = proplists:get_value(client_verification_opts, Config),
+ ServerOpts = proplists:get_value(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server =
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 9632103696..7a644968f2 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -278,8 +278,11 @@ check_result(Server, ServerMsg, Client, ClientMsg) ->
check_result(Server, ServerMsg);
{Port, {data,Debug}} when is_port(Port) ->
- ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]),
+ ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]),
check_result(Server, ServerMsg, Client, ClientMsg);
+ {Port,closed} when is_port(Port) ->
+ ct:log("~p:~p~n Openssl port ~n",[?MODULE,?LINE]),
+ check_result(Server, ServerMsg, Client, ClientMsg);
Unexpected ->
Reason = {{expected, {Client, ClientMsg}},
{expected, {Server, ServerMsg}}, {got, Unexpected}},
@@ -291,11 +294,11 @@ check_result(Pid, Msg) ->
{Pid, Msg} ->
ok;
{Port, {data,Debug}} when is_port(Port) ->
- ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]),
+ ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]),
check_result(Pid,Msg);
- %% {Port, {exit_status, Status}} when is_port(Port) ->
- %% ct:log("~p:~p Exit status: ~p~n",[?MODULE,?LINE, Status]),
- %% check_result(Pid, Msg);
+ {Port,closed} when is_port(Port)->
+ ct:log("~p:~p Openssl port closed ~n",[?MODULE,?LINE]),
+ check_result(Pid, Msg);
Unexpected ->
Reason = {{expected, {Pid, Msg}},
{got, Unexpected}},
@@ -398,27 +401,22 @@ cert_options(Config) ->
{ssl_imp, new}]},
{server_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- %%{server_anon, [{ssl_imp, new},{reuseaddr, true}, {ciphers, anonymous_suites()}]},
- {client_psk, [{ssl_imp, new},{reuseaddr, true},
+ {client_psk, [{ssl_imp, new},
{psk_identity, "Test-User"},
{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_hint, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{psk_identity, "HINT"},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_anon, [{ssl_imp, new},{reuseaddr, true},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_anon_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_anon_hint, [{ssl_imp, new},{reuseaddr, true},
{psk_identity, "HINT"},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_anon_suites()}]},
- {client_srp, [{ssl_imp, new},{reuseaddr, true},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
+ {client_srp, [{ssl_imp, new},
{srp_identity, {"Test-User", "secret"}}]},
{server_srp, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
@@ -473,7 +471,7 @@ make_dsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_dsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_dsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]},
{server_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
@@ -481,7 +479,7 @@ make_dsa_cert(Config) ->
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{user_lookup_fun, {fun user_lookup/3, undefined}},
{ciphers, srp_dss_suites()}]},
- {client_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
+ {client_srp_dsa, [{ssl_imp, new},
{srp_identity, {"Test-User", "secret"}},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
@@ -502,7 +500,7 @@ make_ecdsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_ecdsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config];
@@ -537,7 +535,7 @@ make_ecdh_rsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_ecdh_rsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config];
@@ -557,7 +555,7 @@ make_mix_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_mix_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_mix_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config].
@@ -827,17 +825,17 @@ rsa_suites(CounterPart) ->
({dhe_rsa, des_cbc, sha}) when FIPS == true ->
false;
({rsa, Cipher, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({dhe_rsa, Cipher, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({ecdhe_rsa, Cipher, _}) when ECC == true ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({rsa, Cipher, _, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({dhe_rsa, Cipher, _,_}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({ecdhe_rsa, Cipher, _,_}) when ECC == true ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
(_) ->
false
end,
@@ -930,44 +928,12 @@ anonymous_suites(Version) ->
Suites = ssl_cipher:anonymous_suites(Version),
ssl_cipher:filter_suites(Suites).
-psk_suites() ->
- Suites =
- [{psk, rc4_128, sha},
- {psk, '3des_ede_cbc', sha},
- {psk, aes_128_cbc, sha},
- {psk, aes_256_cbc, sha},
- {psk, aes_128_cbc, sha256},
- {psk, aes_256_cbc, sha384},
- {dhe_psk, rc4_128, sha},
- {dhe_psk, '3des_ede_cbc', sha},
- {dhe_psk, aes_128_cbc, sha},
- {dhe_psk, aes_256_cbc, sha},
- {dhe_psk, aes_128_cbc, sha256},
- {dhe_psk, aes_256_cbc, sha384},
- {rsa_psk, rc4_128, sha},
- {rsa_psk, '3des_ede_cbc', sha},
- {rsa_psk, aes_128_cbc, sha},
- {rsa_psk, aes_256_cbc, sha},
- {rsa_psk, aes_128_cbc, sha256},
- {rsa_psk, aes_256_cbc, sha384},
- {psk, aes_128_gcm, null, sha256},
- {psk, aes_256_gcm, null, sha384},
- {dhe_psk, aes_128_gcm, null, sha256},
- {dhe_psk, aes_256_gcm, null, sha384},
- {rsa_psk, aes_128_gcm, null, sha256},
- {rsa_psk, aes_256_gcm, null, sha384}],
+psk_suites(Version) ->
+ Suites = ssl_cipher:psk_suites(Version),
ssl_cipher:filter_suites(Suites).
-psk_anon_suites() ->
- Suites =
- [{psk, rc4_128, sha},
- {psk, '3des_ede_cbc', sha},
- {psk, aes_128_cbc, sha},
- {psk, aes_256_cbc, sha},
- {dhe_psk, rc4_128, sha},
- {dhe_psk, '3des_ede_cbc', sha},
- {dhe_psk, aes_128_cbc, sha},
- {dhe_psk, aes_256_cbc, sha}],
+psk_anon_suites(Version) ->
+ Suites = [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)],
ssl_cipher:filter_suites(Suites).
srp_suites() ->
@@ -1089,14 +1055,16 @@ init_tls_version(Version, Config)
application:load(ssl),
application:set_env(ssl, dtls_protocol_version, Version),
ssl:start(),
- [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}|Config];
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]} | NewConfig];
init_tls_version(Version, Config) ->
ssl:stop(),
application:load(ssl),
application:set_env(ssl, protocol_version, Version),
ssl:start(),
- [{protocol, tls}|Config].
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, tls} | NewConfig].
sufficient_crypto_support(Version)
when Version == 'tlsv1.2'; Version == 'dtlsv1.2' ->
@@ -1231,19 +1199,37 @@ check_sane_openssl_version(Version) ->
enough_openssl_crl_support("OpenSSL 0." ++ _) -> false;
enough_openssl_crl_support(_) -> true.
-wait_for_openssl_server(Port) ->
- wait_for_openssl_server(Port, 10).
-wait_for_openssl_server(_, 0) ->
+wait_for_openssl_server(Port, tls) ->
+ do_wait_for_openssl_tls_server(Port, 10);
+wait_for_openssl_server(Port, dtls) ->
+ do_wait_for_openssl_dtls_server(Port, 10).
+
+do_wait_for_openssl_tls_server(_, 0) ->
exit(failed_to_connect_to_openssl);
-wait_for_openssl_server(Port, N) ->
+do_wait_for_openssl_tls_server(Port, N) ->
case gen_tcp:connect("localhost", Port, []) of
{ok, S} ->
gen_tcp:close(S);
_ ->
ct:sleep(?SLEEP),
- wait_for_openssl_server(Port, N-1)
+ do_wait_for_openssl_tls_server(Port, N-1)
end.
+do_wait_for_openssl_dtls_server(_, 0) ->
+ %%exit(failed_to_connect_to_openssl);
+ ok;
+do_wait_for_openssl_dtls_server(Port, N) ->
+ %% case gen_udp:open(0) of
+ %% {ok, S} ->
+ %% gen_udp:connect(S, "localhost", Port),
+ %% gen_udp:close(S);
+ %% _ ->
+ %% ct:sleep(?SLEEP),
+ %% do_wait_for_openssl_dtls_server(Port, N-1)
+ %% end.
+ ct:sleep(500),
+ do_wait_for_openssl_dtls_server(Port, N-1).
+
version_flag(tlsv1) ->
"-tls1";
version_flag('tlsv1.1') ->
@@ -1253,10 +1239,14 @@ version_flag('tlsv1.2') ->
version_flag(sslv3) ->
"-ssl3";
version_flag(sslv2) ->
- "-ssl2".
-
-filter_suites(Ciphers0) ->
- Version = tls_record:highest_protocol_version([]),
+ "-ssl2";
+version_flag('dtlsv1.2') ->
+ "-dtls1_2";
+version_flag('dtlsv1') ->
+ "-dtls1".
+
+filter_suites(Ciphers0, AtomVersion) ->
+ Version = tls_version(AtomVersion),
Supported0 = ssl_cipher:suites(Version)
++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
@@ -1338,7 +1328,7 @@ protocol_version(Config) ->
protocol_version(Config, tuple) ->
case proplists:get_value(protocol, Config) of
dtls ->
- dtls_record:protocol_version(dtls_record:highest_protocol_version([]));
+ dtls_record:highest_protocol_version(dtls_record:supported_protocol_versions());
_ ->
tls_record:highest_protocol_version(tls_record:supported_protocol_versions())
end;
@@ -1372,6 +1362,7 @@ clean_env() ->
application:unset_env(ssl, session_cache_client_max),
application:unset_env(ssl, session_cache_server_max),
application:unset_env(ssl, ssl_pem_cache_clean),
+ application:unset_env(ssl, bypass_pem_cache),
application:unset_env(ssl, alert_timeout).
clean_start() ->
@@ -1379,3 +1370,105 @@ clean_start() ->
application:load(ssl),
clean_env(),
ssl:start().
+
+is_psk_anon_suite({psk, _,_}) ->
+ true;
+is_psk_anon_suite({dhe_psk,_,_}) ->
+ true;
+is_psk_anon_suite({psk, _,_,_}) ->
+ true;
+is_psk_anon_suite({dhe_psk, _,_,_}) ->
+ true;
+is_psk_anon_suite(_) ->
+ false.
+
+cipher_atom(aes_256_cbc) ->
+ aes_cbc256;
+cipher_atom(aes_128_cbc) ->
+ aes_cbc128;
+cipher_atom('3des_ede_cbc') ->
+ des_ede3;
+cipher_atom(Atom) ->
+ Atom.
+tls_version('dtlsv1' = Atom) ->
+ dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom));
+tls_version('dtlsv1.2' = Atom) ->
+ dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom));
+tls_version(Atom) ->
+ tls_record:protocol_version(Atom).
+
+dtls_hello() ->
+ [1,
+ <<0,1,4>>,
+ <<0,0>>,
+ <<0,0,0>>,
+ <<0,1,4>>,
+ <<254,253,88,
+ 156,129,61,
+ 131,216,15,
+ 131,194,242,
+ 46,154,190,
+ 20,228,234,
+ 234,150,44,
+ 62,96,96,103,
+ 127,95,103,
+ 23,24,42,138,
+ 13,142,32,57,
+ 230,177,32,
+ 210,154,152,
+ 188,121,134,
+ 136,53,105,
+ 118,96,106,
+ 103,231,223,
+ 133,10,165,
+ 50,32,211,
+ 227,193,14,
+ 181,143,48,
+ 66,0,0,100,0,
+ 255,192,44,
+ 192,48,192,
+ 36,192,40,
+ 192,46,192,
+ 50,192,38,
+ 192,42,0,159,
+ 0,163,0,107,
+ 0,106,0,157,
+ 0,61,192,43,
+ 192,47,192,
+ 35,192,39,
+ 192,45,192,
+ 49,192,37,
+ 192,41,0,158,
+ 0,162,0,103,
+ 0,64,0,156,0,
+ 60,192,10,
+ 192,20,0,57,
+ 0,56,192,5,
+ 192,15,0,53,
+ 192,8,192,18,
+ 0,22,0,19,
+ 192,3,192,13,
+ 0,10,192,9,
+ 192,19,0,51,
+ 0,50,192,4,
+ 192,14,0,47,
+ 1,0,0,86,0,0,
+ 0,14,0,12,0,
+ 0,9,108,111,
+ 99,97,108,
+ 104,111,115,
+ 116,0,10,0,
+ 58,0,56,0,14,
+ 0,13,0,25,0,
+ 28,0,11,0,12,
+ 0,27,0,24,0,
+ 9,0,10,0,26,
+ 0,22,0,23,0,
+ 8,0,6,0,7,0,
+ 20,0,21,0,4,
+ 0,5,0,18,0,
+ 19,0,1,0,2,0,
+ 3,0,15,0,16,
+ 0,17,0,11,0,
+ 2,1,0>>].
+
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index e99340822d..7a1dce70c2 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -42,7 +42,9 @@ all() ->
{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
- {group, 'sslv3'}
+ {group, 'sslv3'},
+ {group, 'dtlsv1.2'},
+ {group, 'dtlsv1'}
].
groups() ->
@@ -50,7 +52,10 @@ groups() ->
{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
- {'sslv3', [], all_versions_tests()}].
+ {'sslv3', [], all_versions_tests()},
+ {'dtlsv1.2', [], dtls_all_versions_tests()},
+ {'dtlsv1', [], dtls_all_versions_tests()}
+ ].
basic_tests() ->
[basic_erlang_client_openssl_server,
@@ -78,6 +83,25 @@ all_versions_tests() ->
expired_session,
ssl2_erlang_server_openssl_client
].
+dtls_all_versions_tests() ->
+ [
+ %%erlang_client_openssl_server,
+ erlang_server_openssl_client,
+ %%erlang_client_openssl_server_dsa_cert,
+ erlang_server_openssl_client_dsa_cert
+ %% This one works but gets port EXIT first some times
+ %%erlang_server_openssl_client_reuse_session
+ %%erlang_client_openssl_server_renegotiate,
+ %%erlang_client_openssl_server_nowrap_seqnum,
+ %%erlang_server_openssl_client_nowrap_seqnum,
+ %%erlang_client_openssl_server_no_server_ca_cert,
+ %%erlang_client_openssl_server_client_cert,
+ %%erlang_server_openssl_client_client_cert
+ %%ciphers_rsa_signed_certs,
+ %%ciphers_dsa_signed_certs,
+ %%erlang_client_bad_openssl_server,
+ %%expired_session
+ ].
alpn_tests() ->
[erlang_client_alpn_openssl_server_alpn,
@@ -284,7 +308,8 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+
+ ssl_test_lib:wait_for_openssl_server(Port, tls),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -357,7 +382,7 @@ erlang_client_openssl_server(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -431,7 +456,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -551,7 +576,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -600,7 +625,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -681,7 +706,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -724,7 +749,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -856,7 +881,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) ->
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -911,7 +936,7 @@ expired_session(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, tls),
Client0 =
ssl_test_lib:start_client([{node, ClientNode},
@@ -1399,7 +1424,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
ConnectionInfo = {ok, {Version, CipherSuite}},
@@ -1469,7 +1494,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1505,7 +1530,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba
Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1574,7 +1599,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1639,7 +1664,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 2cdb825d75..415a47949d 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 8.1
+SSL_VSN = 8.1.1
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index 2a413835d0..f7f3f7b504 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -511,6 +511,33 @@ true
</func>
<func>
+ <name name="safe_relative_path" arity="1"/>
+ <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary>
+ <desc>
+ <p>Sanitizes the relative path by eliminating ".." and "."
+ components to protect against directory traversal attacks.
+ Either returns the sanitized path name, or the atom
+ <c>unsafe</c> if the path is unsafe.
+ The path is considered unsafe in the following circumstances:</p>
+ <list type="bulleted">
+ <item><p>The path is not relative.</p></item>
+ <item><p>A ".." component would climb up above the root of
+ the relative path.</p></item>
+ </list>
+ <p><em>Examples:</em></p>
+ <pre>
+1> <input>filename:safe_relative_path("dir/sub_dir/..").</input>
+"dir"
+2> <input>filename:safe_relative_path("dir/..").</input>
+[]
+3> <input>filename:safe_relative_path("dir/../..").</input>
+unsafe
+4> <input>filename:safe_relative_path("/abs/path").</input>
+unsafe</pre>
+ </desc>
+ </func>
+
+ <func>
<name name="split" arity="1"/>
<fsummary>Split a filename into its path components.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index fd498ee82e..5eb13db1aa 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year>
+ <year>2016-2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -587,8 +587,8 @@ handle_event(_, _, State, Data) ->
<name name="state_enter"/>
<desc>
<p>
- If the state machine should use <em>state enter calls</em>
- is selected when starting the <c>gen_statem</c>
+ Whether the state machine should use <em>state enter calls</em>
+ or not is selected when starting the <c>gen_statem</c>
and after code change using the return value from
<seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>.
</p>
@@ -606,7 +606,16 @@ handle_event(_, _, State, Data) ->
See
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>
and
- <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ Such a call can be repeated by returning a
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ tuple from the state callback.
</p>
<p>
If
@@ -625,7 +634,8 @@ handle_event(_, _, State, Data) ->
right before entering the initial state even though this
formally is not a state change.
In this case <c>OldState</c> will be the same as <c>State</c>,
- which can not happen for a subsequent state change.
+ which can not happen for a subsequent state change,
+ but will happen when repeating the state enter call.
</p>
</desc>
</datatype>
@@ -640,7 +650,15 @@ handle_event(_, _, State, Data) ->
<list type="ordered">
<item>
<p>
- If the state changes or is the initial state, and
+ If the state changes, is the initial state,
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ is used, and also
<seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
are used, the <c>gen_statem</c> calls
the new state callback with arguments
@@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="init_result"/>
+ <desc>
+ <p>
+ For a succesful initialization,
+ <c><anno>State</anno></c> is the initial
+ <seealso marker="#type-state"><c>state()</c></seealso>
+ and <c><anno>Data</anno></c> the initial server
+ <seealso marker="#type-data"><c>data()</c></seealso>
+ of the <c>gen_statem</c>.
+ </p>
+ <p>
+ The <seealso marker="#type-action"><c>Actions</c></seealso>
+ are executed when entering the first
+ <seealso marker="#type-state">state</seealso> just as for a
+ <seealso marker="#state callback">state callback</seealso>,
+ except that the action <c>postpone</c> is forced to
+ <c>false</c> since there is no event to postpone.
+ </p>
+ <p>
+ For an unsuccesful initialization,
+ <c>{stop,<anno>Reason</anno>}</c>
+ or <c>ignore</c> should be used; see
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="state_enter_result"/>
<desc>
<p>
@@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) ->
<c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>.
</p>
</item>
+ <tag><c>repeat_state</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state, or
+ does a state transition to the current state if you like,
+ sets <c><anno>NewData</anno></c>,
+ and executes all <c><anno>Actions</anno></c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state</c> is the same as
+ <c>keep_state</c>.
+ </p>
+ </item>
+ <tag><c>repeat_state_and_data</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state and data, or
+ does a state transition to the current state if you like,
+ and executes all <c><anno>Actions</anno></c>.
+ This is the same as
+ <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state_and_data</c> is the same as
+ <c>keep_state_and_data</c>.
+ </p>
+ </item>
<tag><c>stop</c></tag>
<item>
<p>
@@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) ->
It is recommended to use an atom as <c>Reason</c> since
it will be wrapped in an <c>{error,Reason}</c> tuple.
</p>
+ <p>
+ Also note when upgrading a <c>gen_statem</c>,
+ this function and hence
+ the <c>Change={advanced,Extra}</c> parameter in the
+ <seealso marker="sasl:appup"><c>appup</c></seealso> file
+ is not only needed to update the internal state
+ or to act on the <c>Extra</c> argument.
+ It is also needed if an upgrade or downgrade should change
+ <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>,
+ or else the callback mode after the code change
+ will not be honoured,
+ most probably causing a server crash.
+ </p>
</desc>
</func>
<func>
- <name>Module:init(Args) -> Result</name>
+ <name>Module:init(Args) -> Result(StateType)</name>
<fsummary>
Optional function for initializing process and internal state.
</fsummary>
<type>
<v>Args = term()</v>
- <v>Result = {ok,State,Data}</v>
- <v>&nbsp;| {ok,State,Data,Actions}</v>
- <v>&nbsp;| {stop,Reason} | ignore</v>
- <v>State = <seealso marker="#type-state">state()</seealso></v>
- <v>
- Data = <seealso marker="#type-data">data()</seealso>
- </v>
<v>
- Actions =
- [<seealso marker="#type-action">action()</seealso>] |
- <seealso marker="#type-action">action()</seealso>
+ Result(StateType) =
+ <seealso marker="#type-init_result">init_result(StateType)</seealso>
</v>
- <v>Reason = term()</v>
</type>
<desc>
<marker id="Module:init-1"/>
@@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) ->
the implementation state and server data.
</p>
<p>
- <c>Args</c> is the <c>Args</c> argument provided to the start
+ <c>Args</c> is the <c>Args</c> argument provided to that start
function.
</p>
- <p>
- If the initialization is successful, the function is to
- return <c>{ok,State,Data}</c> or
- <c>{ok,State,Data,Actions}</c>.
- <c>State</c> is the initial
- <seealso marker="#type-state"><c>state()</c></seealso>
- and <c>Data</c> the initial server
- <seealso marker="#type-data"><c>data()</c></seealso>.
- </p>
- <p>
- The <seealso marker="#type-action"><c>Actions</c></seealso>
- are executed when entering the first
- <seealso marker="#type-state">state</seealso> just as for a
- <seealso marker="#state callback">state callback</seealso>.
- </p>
- <p>
- If the initialization fails,
- the function is to return <c>{stop,Reason}</c>
- or <c>ignore</c>; see
- <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
- </p>
<note>
<p>
This callback is optional, so a callback module does not need
@@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-enter_action">actions</seealso>
that may be returned:
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
- and
+ is not allowed since a <em>state enter call</em> is not
+ an event so there is no event to postpone, and
<seealso marker="#type-action"><c>{next_event,_,_}</c></seealso>
- are not allowed.
+ is not allowed since using <em>state enter calls</em>
+ should not affect how events are consumed and produced.
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- You are advised to use <c>{keep_state,...}</c> or
- <c>keep_state_and_data</c>.
+ It is possible to use <c>{repeat_state, ...}</c>,
+ <c>{repeat_state_and_data,_}</c> or
+ <c>repeat_state_and_data</c> but all of them makes little
+ sense since you immediately will be called again with a new
+ <em>state enter call</em> making this just a weird way
+ of looping, and there are better ways to loop in Erlang.
+ You are advised to use <c>{keep_state,...}</c>,
+ <c>{keep_state_and_data,_}</c> or
+ <c>keep_state_and_data</c> since you can not change states
+ from a <em>state enter call</em> anyway.
</p>
<p>
Note the fact that you can use
<seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>
to return the result, which can be useful.
For example to bail out with <c>throw(keep_state_and_data)</c>
- from deep within complex code that is in no position to
- return <c>{next_state,State,Data}</c>.
+ from deep within complex code that can not
+ return <c>{next_state,State,Data}</c> because
+ <c>State</c> or <c>Data</c> is no longer in scope.
</p>
</desc>
</func>
@@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) ->
<v>Ignored = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_statem</c> module provides a default
+ implementation without cleanup.</p>
+ </note>
<p>
This function is called by a <c>gen_statem</c>
when it is about to terminate. It is to be the opposite of
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 9091a46df9..45171f814d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -83,8 +83,8 @@
<p>If the modules used to implement the process change dynamically
during runtime, the process must understand one more message. An
example is the <seealso marker="gen_event"><c>gen_event</c></seealso>
- processes. The message is <c>{get_modules, From}</c>.
- The reply to this message is <c>From ! {modules, Modules}</c>, where
+ processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>.
+ The reply to this message is <c>From ! {Ref, Modules}</c>, where
<c>Modules</c> is a list of the currently active modules in the
process.</p>
<p>This message is used by the release handler to find which
diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl
index 5f821caef0..a1a97af4c5 100644
--- a/lib/stdlib/src/edlin_expand.erl
+++ b/lib/stdlib/src/edlin_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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.
@@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) ->
%% Return the list of names L in multiple columns.
format_matches(L) ->
- S = format_col(lists:sort(L), []),
+ {S1, Dots} = format_col(lists:sort(L), []),
+ S = case Dots of
+ true ->
+ {_, Prefix} = longest_common_head(vals(L)),
+ PrefixLen = length(Prefix),
+ case PrefixLen =< 3 of
+ true -> S1; % Do not replace the prefix with "...".
+ false ->
+ LeadingDotsL = leading_dots(L, PrefixLen),
+ {S2, _} = format_col(lists:sort(LeadingDotsL), []),
+ S2
+ end;
+ false -> S1
+ end,
["\n" | S].
format_col([], _) -> [];
-format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc).
-
-format_col(X, Width, Len, Acc) when Width + Len > 79 ->
- format_col(X, Width, 0, ["\n" | Acc]);
-format_col([A|T], Width, Len, Acc0) ->
- H = case A of
- %% If it's a tuple {string(), integer()}, we assume it's an
- %% arity, and meant to be printed.
- {H0, I} when is_integer(I) ->
- H0 ++ "/" ++ integer_to_list(I);
- {H1, _} -> H1;
- H2 -> H2
- end,
- Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0],
- format_col(T, Width, Len+Width, Acc);
-format_col([], _, _, Acc) ->
- lists:reverse(Acc, "\n").
-
-field_width(L) -> field_width(L, 0).
-
-field_width([{H,_}|T], W) ->
+format_col(L, Acc) ->
+ LL = 79,
+ format_col(L, field_width(L, LL), 0, Acc, LL, false).
+
+format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL ->
+ format_col(X, Width, 0, ["\n" | Acc], LL, Dots);
+format_col([A|T], Width, Len, Acc0, LL, Dots) ->
+ {H0, R} = format_val(A),
+ Hmax = LL - length(R),
+ {H, NewDots} =
+ case length(H0) > Hmax of
+ true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true};
+ false -> {H0, Dots}
+ end,
+ Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0],
+ format_col(T, Width, Len+Width, Acc, LL, NewDots);
+format_col([], _, _, Acc, _LL, Dots) ->
+ {lists:reverse(Acc, "\n"), Dots}.
+
+format_val({H, I}) when is_integer(I) ->
+ %% If it's a tuple {string(), integer()}, we assume it's an
+ %% arity, and meant to be printed.
+ {H, "/" ++ integer_to_list(I)};
+format_val({H, _}) ->
+ {H, ""};
+format_val(H) ->
+ {H, ""}.
+
+field_width(L, LL) -> field_width(L, 0, LL).
+
+field_width([{H,_}|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([H|T], W) ->
+field_width([H|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([], W) when W < 40 ->
+field_width([], W, LL) when W < LL - 3 ->
W + 4;
-field_width([], _) ->
- 40.
+field_width([], _, LL) ->
+ LL.
+
+vals([]) -> [];
+vals([{S, _}|L]) -> [S|vals(L)];
+vals([S|L]) -> [S|vals(L)].
+
+leading_dots([], _Len) -> [];
+leading_dots([{H, I}|L], Len) ->
+ [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)];
+leading_dots([H|L], Len) ->
+ ["..." ++ nthtail(Len, H)|leading_dots(L, Len)].
longest_common_head([]) ->
no;
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/src/filename.erl b/lib/stdlib/src/filename.erl
index c4586171ca..5d60b3837e 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -34,7 +34,8 @@
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
- rootname/1, rootname/2, split/1, nativename/1]).
+ rootname/1, rootname/2, split/1, nativename/1,
+ safe_relative_path/1]).
-export([find_src/1, find_src/2, flatten/1]).
-export([basedir/2, basedir/3]).
@@ -750,6 +751,39 @@ separators() ->
_ -> {false, false}
end.
+-spec safe_relative_path(Filename) -> 'unsafe' | SafeFilename when
+ Filename :: file:name_all(),
+ SafeFilename :: file:name_all().
+
+safe_relative_path(Path) ->
+ case pathtype(Path) of
+ relative ->
+ Cs0 = split(Path),
+ safe_relative_path_1(Cs0, []);
+ _ ->
+ unsafe
+ end.
+
+safe_relative_path_1(["."|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([<<".">>|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([".."|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([<<"..">>|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([H|T], Acc) ->
+ safe_relative_path_1(T, [H|Acc]);
+safe_relative_path_1([], []) ->
+ [];
+safe_relative_path_1([], Acc) ->
+ join(lists:reverse(Acc)).
+
+climb(_, []) ->
+ unsafe;
+climb(T, [_|Acc]) ->
+ safe_relative_path_1(T, Acc).
+
%% find_src(Module) --
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index ccacf658e9..e55cdddb9a 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -742,7 +742,7 @@ stop_handlers([], _) ->
[].
%% Message from the release_handler.
-%% The list of modules got to be a set !
+%% The list of modules got to be a set, i.e. no duplicate elements!
get_modules(MSL) ->
Mods = [Handler#handler.module || Handler <- MSL],
ordsets:to_list(ordsets:from_list(Mods)).
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 018aca90e6..cacc932ec4 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-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.
@@ -47,15 +47,17 @@
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
- init_result/0,
callback_mode_result/0,
- state_function_result/0,
- handle_event_result/0,
+ init_result/1,
state_enter_result/1,
event_handler_result/1,
reply_action/0,
enter_action/0,
action/0]).
+%% Old types, not advertised
+-export_type(
+ [state_function_result/0,
+ handle_event_result/0]).
%% Type that is exported just to be documented
-export_type([transition_option/0]).
@@ -143,9 +145,10 @@
{'reply', % Reply to a caller
From :: from(), Reply :: term()}.
--type init_result() ::
- {ok, state(), data()} |
- {ok, state(), data(), [action()] | action()} |
+-type init_result(StateType) ::
+ {ok, State :: StateType, Data :: data()} |
+ {ok, State :: StateType, Data :: data(),
+ Actions :: [action()] | action()} |
'ignore' |
{'stop', Reason :: term()}.
@@ -182,12 +185,23 @@
'keep_state_and_data' | % {keep_state_and_data,[]}
{'keep_state_and_data', % Keep state and data -> only actions
Actions :: [ActionType] | ActionType} |
+ %%
+ {'repeat_state', % {repeat_state,NewData,[]}
+ NewData :: data()} |
+ {'repeat_state', % Repeat state, change data
+ NewData :: data(),
+ Actions :: [ActionType] | ActionType} |
+ 'repeat_state_and_data' | % {repeat_state_and_data,[]}
+ {'repeat_state_and_data', % Repeat state and data -> only actions
+ Actions :: [ActionType] | ActionType} |
+ %%
'stop' | % {stop,normal}
{'stop', % Stop the server
Reason :: term()} |
{'stop', % Stop the server
Reason :: term(),
NewData :: data()} |
+ %%
{'stop_and_reply', % Reply then stop the server
Reason :: term(),
Replies :: [reply_action()] | reply_action()} |
@@ -201,7 +215,7 @@
%% the server is not running until this function has returned
%% an {ok, ...} tuple. Thereafter the state callbacks are called
%% for all events to this server.
--callback init(Args :: term()) -> init_result().
+-callback init(Args :: term()) -> init_result(state()).
%% This callback shall return the callback mode of the callback module.
%%
@@ -275,6 +289,8 @@
-optional_callbacks(
[init/1, % One may use enter_loop/5,6,7 instead
format_status/2, % Has got a default implementation
+ terminate/3, % Has got a default implementation
+ code_change/4, % Only needed by advanced soft upgrade
%%
state_name/3, % Example for callback_mode() =:= state_functions:
%% there has to be a StateName/3 callback function
@@ -304,12 +320,16 @@ event_type({call,From}) ->
from(From);
event_type(Type) ->
case Type of
+ {call,From} ->
+ from(From);
cast ->
true;
info ->
true;
timeout ->
true;
+ state_timeout ->
+ true;
internal ->
true;
_ ->
@@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
true ->
[Actions,{postpone,false}]
end,
+ TimerRefs = #{},
+ %% Key: timer ref
+ %% Value: the timer type i.e the timer's event type
+ %%
+ TimerTypes = #{},
+ %% Key: timer type i.e the timer's event type
+ %% Value: timer ref
+ %%
+ %% We add a timer to both timer_refs and timer_types
+ %% when we start it. When we request an asynchronous
+ %% timer cancel we remove it from timer_types. When
+ %% the timer cancel message arrives we remove it from
+ %% timer_refs.
+ %%
+ Hibernate = false,
+ CancelTimers = 0,
S = #{
callback_mode => undefined,
state_enter => false,
@@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
state => State,
data => Data,
postponed => P,
- %% The rest of the fields are set from to the arguments to
- %% loop_event_actions/10 when it finally loops back to loop/3
- %% in loop_events/10
%%
- %% Marker for initial state, cleared immediately when used
- init_state => true
+ %% The following fields are finally set from to the arguments to
+ %% loop_event_actions/9 when it finally loops back to loop/3
+ %% in loop_event_result/11
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes,
+ hibernate => Hibernate,
+ cancel_timers => CancelTimers
},
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
- TimerRefs = #{},
- TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, State, Data, NewActions);
+ Parent, NewDebug, NewS,
+ Events, Event, State, Data, NewActions, true);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- NewDebug, S, [Event|Events])
+ Class, Reason, Stacktrace, NewDebug,
+ S, [Event|Events])
end.
%%%==========================================================================
@@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) ->
loop(Parent, Debug, S).
system_terminate(Reason, _Parent, Debug, S) ->
- terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, []).
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).
system_code_change(
#{module := Module,
@@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) ->
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3
%% Entry point for system_continue/3
-loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
- case Hibernate of
- true ->
- %% Does not return but restarts process at
- %% wakeup_from_hibernate/3 that jumps to loop_receive/3
- proc_lib:hibernate(
- ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
- error(
- {should_not_have_arrived_here_but_instead_in,
- {wakeup_from_hibernate,3}});
- false ->
- loop_receive(Parent, Debug, S)
- end.
+loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) ->
+ loop_hibernate(Parent, Debug, S);
+loop(Parent, Debug, S) ->
+ loop_receive(Parent, Debug, S).
+
+loop_hibernate(Parent, Debug, S) ->
+ %% Does not return but restarts process at
+ %% wakeup_from_hibernate/3 that jumps to loop_receive/3
+ proc_lib:hibernate(
+ ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
+ error(
+ {should_not_have_arrived_here_but_instead_in,
+ {wakeup_from_hibernate,3}}).
%% Entry point for wakeup_from_hibernate/3
-loop_receive(
- Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
+loop_receive(Parent, Debug, S) ->
receive
Msg ->
case Msg of
@@ -821,30 +854,87 @@ loop_receive(
%% Does not return but tail recursively calls
%% system_continue/3 that jumps to loop/3
sys:handle_system_msg(
- Req, Pid, Parent, ?MODULE, Debug, S, Hibernate);
+ Req, Pid, Parent, ?MODULE, Debug, S,
+ Hibernate);
{'EXIT',Parent,Reason} = EXIT ->
- %% EXIT is not a 2-tuple and therefore
- %% not an event and has no event_type(),
- %% but this will stand out in the crash report...
- terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
+ %% EXIT is not a 2-tuple therefore
+ %% not an event but this will stand out
+ %% in the crash report...
+ Q = [EXIT],
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
{timeout,TimerRef,TimerMsg} ->
+ #{timer_refs := TimerRefs,
+ timer_types := TimerTypes,
+ hibernate := Hibernate} = S,
case TimerRefs of
#{TimerRef := TimerType} ->
- Event = {TimerType,TimerMsg},
- %% Unregister the triggered timeout
+ %% We know of this timer; is it a running
+ %% timer or a timer being cancelled that
+ %% managed to send a late timeout message?
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ %% The timer type maps back to this
+ %% timer ref, so it was a running timer
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewTimerTypes =
+ maps:remove(TimerType, TimerTypes),
+ loop_receive_result(
+ Parent, Debug,
+ S#{
+ timer_refs := NewTimerRefs,
+ timer_types := NewTimerTypes},
+ Hibernate,
+ Event);
+ _ ->
+ %% This was a late timeout message
+ %% from timer being cancelled, so
+ %% ignore it and expect a cancel_timer
+ %% msg shortly
+ loop_receive(Parent, Debug, S)
+ end;
+ _ ->
+ %% Not our timer; present it as an event
+ Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes),
- Event);
+ Parent, Debug, S, Hibernate, Event)
+ end;
+ {cancel_timer,TimerRef,_} ->
+ #{timer_refs := TimerRefs,
+ cancel_timers := CancelTimers,
+ hibernate := Hibernate} = S,
+ case TimerRefs of
+ #{TimerRef := _} ->
+ %% We must have requested a cancel
+ %% of this timer so it is already
+ %% removed from TimerTypes
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewCancelTimers = CancelTimers - 1,
+ NewS =
+ S#{
+ timer_refs := NewTimerRefs,
+ cancel_timers := NewCancelTimers},
+ if
+ Hibernate =:= true, NewCancelTimers =:= 0 ->
+ %% No more cancel_timer msgs to expect;
+ %% we can hibernate
+ loop_hibernate(Parent, Debug, NewS);
+ NewCancelTimers >= 0 -> % Assert
+ loop_receive(Parent, Debug, NewS)
+ end;
_ ->
+ %% Not our cancel_timer msg;
+ %% present it as an event
Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end;
_ ->
+ %% External msg
+ #{hibernate := Hibernate} = S,
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -855,208 +945,212 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end
end.
loop_receive_result(
- Parent, Debug, #{state := State} = S,
- TimerRefs, TimerTypes, Event) ->
- %% The fields 'timer_refs', 'timer_types' and 'hibernate'
- %% are now invalid in state map S - they will be recalculated
- %% and restored when we return to loop/3
- %%
+ Parent, Debug,
+ #{state := State,
+ timer_types := TimerTypes, cancel_timers := CancelTimers} = S,
+ Hibernate, Event) ->
+ %% From now the 'hibernate' field in S is invalid
+ %% and will be restored when looping back
+ %% in loop_event_result/11
NewDebug = sys_debug(Debug, S, State, {in,Event}),
- %% Here the queue of not yet handled events is created
+ %% Here is the queue of not yet handled events created
Events = [],
- Hibernate = false,
- loop_event(
- Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate).
+ %% Cancel any running event timer
+ case
+ cancel_timer_by_type(timeout, TimerTypes, CancelTimers)
+ of
+ {_,CancelTimers} ->
+ %% No timer cancelled
+ loop_event(Parent, NewDebug, S, Events, Event, Hibernate);
+ {NewTimerTypes,NewCancelTimers} ->
+ %% The timer is removed from NewTimerTypes but
+ %% remains in TimerRefs until we get
+ %% the cancel_timer msg
+ NewS =
+ S#{
+ timer_types := NewTimerTypes,
+ cancel_timers := NewCancelTimers},
+ loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate)
+ end.
%% Entry point for handling an event, received or enqueued
loop_event(
- Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Parent, Debug,
+ #{state := State, data := Data} = S,
Events, {Type,Content} = Event, Hibernate) ->
%%
- %% If Hibernate is true here it can only be
+ %% If (this old) Hibernate is true here it can only be
%% because it was set from an event action
- %% and we did not go into hibernation since there
- %% were events in queue, so we do what the user
+ %% and we did not go into hibernation since there were
+ %% events in queue, so we do what the user
%% might rely on i.e collect garbage which
%% would have happened if we actually hibernated
%% and immediately was awakened
Hibernate andalso garbage_collect(),
case call_state_function(S, Type, Content, State, Data) of
{ok,Result,NewS} ->
- %% Cancel event timeout
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(
- timeout, TimerRefs, TimerTypes),
- {NewData,NextState,Actions} =
+ {NextState,NewData,Actions,EnterCall} =
parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
+ true, Debug, NewS,
+ Events, Event, State, Data, Result),
loop_event_actions(
- Parent, Debug, S, NewTimerRefs, NewTimerTypes,
- Events, Event, NextState, NewData, Actions);
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewData, Actions, EnterCall);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_actions(
Parent, Debug,
- #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData, Actions) ->
+ #{state := State, state_enter := StateEnter} = S,
+ Events, Event, NextState, NewData,
+ Actions, EnterCall) ->
+ %% Hibernate is reborn here as false being
+ %% the default value from parse_actions/4
case parse_actions(Debug, S, State, Actions) of
{ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
if
- StateEnter, NextState =/= State ->
+ StateEnter, EnterCall ->
loop_event_enter(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR);
- StateEnter ->
- case maps:is_key(init_state, S) of
- true ->
- %% Avoid infinite loop in initial state
- %% with state entry events
- NewS = maps:remove(init_state, S),
- loop_event_enter(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- false ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR)
- end;
true ->
loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR)
end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_enter(
- Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state := State} = S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case call_state_function(S, enter, State, NextState, NewData) of
{ok,Result,NewS} ->
- {NewerData,_,Actions} =
- parse_event_result(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewerData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ case parse_event_result(
+ false, Debug, NewS,
+ Events, Event, NextState, NewData, Result) of
+ {_,NewerData,Actions,EnterCall} ->
+ loop_event_enter_actions(
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_enter_actions(
- Parent, Debug, S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state_enter := StateEnter} = S,
Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall) ->
case
parse_enter_actions(
- Debug, S, NextState, Actions,
- Hibernate, TimeoutsR)
+ Debug, S, NextState, Actions, Hibernate, TimeoutsR)
of
{ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ if
+ StateEnter, EnterCall ->
+ loop_event_enter(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_result(
- Parent, Debug,
- #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
- Events, Event, NextState, NewData,
+ Parent, Debug_0,
+ #{state := State, postponed := P_0,
+ timer_refs := TimerRefs_0, timer_types := TimerTypes_0,
+ cancel_timers := CancelTimers_0} = S_0,
+ Events_0, Event_0, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- {NewDebug,P_1} = % Move current event to postponed if Postpone
+ {Debug_1,P_1} = % Move current event to postponed if Postpone
case Postpone of
true ->
- {sys_debug(Debug, S, State, {postpone,Event,State}),
- [Event|P_0]};
+ {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}),
+ [Event_0|P_0]};
false ->
- {sys_debug(Debug, S, State, {consume,Event,State}),
+ {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}),
P_0}
end,
- {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} =
+ {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} =
%% Move all postponed events to queue and cancel the
%% state timeout if the state changes
if
NextState =:= State ->
- {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ {Events_0,P_1,{TimerTypes_0,CancelTimers_0}};
true ->
- {lists:reverse(P_1, Events),[],
+ {lists:reverse(P_1, Events_0),
+ [],
cancel_timer_by_type(
- state_timeout, TimerRefs_0, TimerTypes_0)}
+ state_timeout, TimerTypes_0, CancelTimers_0)}
+ %% The state timer is removed from TimerTypes_1
+ %% but remains in TimerRefs_0 until we get
+ %% the cancel_timer msg
end,
- {TimerRefs_2,TimerTypes_2,TimeoutEvents} =
- %% Stop and start timers non-event timers
- parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR),
+ {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} =
+ %% Stop and start non-event timers
+ parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR),
%% Place next events last in reversed queue
Events_2R = lists:reverse(Events_1, NextEventsR),
%% Enqueue immediate timeout events and start event timer
- {NewTimerRefs,NewTimerTypes,Events_3R} =
- process_timeout_events(
- TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R),
- NewEvents = lists:reverse(Events_3R),
- loop_events(
- Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
- NewEvents, Hibernate, NextState, NewData, NewP).
-
-%% Loop until out of enqueued events
-%%
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [] = _Events, Hibernate, State, Data, P) ->
- %% Update S and loop back to loop/3 to receive a new event
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P,
- hibernate => Hibernate,
- timer_refs => TimerRefs,
- timer_types => TimerTypes},
- loop(Parent, Debug, NewS);
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [Event|Events], Hibernate, State, Data, P) ->
- %% Update S and continue with enqueued events
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P},
- loop_event(
- Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
-
+ Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R),
+ S_1 =
+ S_0#{
+ state := NextState,
+ data := NewData,
+ postponed := P_2,
+ timer_refs := TimerRefs_2,
+ timer_types := TimerTypes_2,
+ cancel_timers := CancelTimers_2,
+ hibernate := Hibernate},
+ case lists:reverse(Events_3R) of
+ [] ->
+ %% Get a new event
+ loop(Parent, Debug_1, S_1);
+ [Event|Events] ->
+ %% Loop until out of enqueued events
+ loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate)
+ end.
%%---------------------------------------------------------------------------
@@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,callback_mode,[]=Args,_}
- |Stacktrace] ->
- {error,
- {undef_callback,{Module,callback_mode,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) ->
call_state_function(
- #{callback_mode := undefined} = S,
- Type, Content, State, Data) ->
+ #{callback_mode := undefined} = S, Type, Content, State, Data) ->
case call_callback_mode(S) of
{ok,NewS} ->
call_state_function(NewS, Type, Content, State, Data);
@@ -1135,13 +1215,12 @@ call_state_function(
Error
end;
call_state_function(
- #{callback_mode := CallbackMode,
- module := Module} = S,
+ #{callback_mode := CallbackMode, module := Module} = S,
Type, Content, State, Data) ->
try
case CallbackMode of
state_functions ->
- erlang:apply(Module, State, [Type,Content,Data]);
+ Module:State(Type, Content, Data);
handle_event_function ->
Module:handle_event(Type, Content, State, Data)
end
@@ -1151,41 +1230,6 @@ call_state_function(
catch
Result ->
{ok,Result,S};
- error:badarg ->
- case erlang:get_stacktrace() of
- [{erlang,apply,
- [Module,State,[Type,Content,Data]=Args],
- _}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- %% We get here e.g if apply fails
- %% due to State not being an atom
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- Stacktrace ->
- {error,badarg,Stacktrace}
- end;
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,State,[Type,Content,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- [{Module,handle_event,[Type,Content,State,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= handle_event_function ->
- {error,
- {undef_state_function,{Module,handle_event,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1193,65 +1237,83 @@ call_state_function(
%% Interpret all callback return variants
parse_event_result(
- AllowStateChange, Debug, S, Result, Events, Event, State, Data) ->
+ AllowStateChange, Debug, S,
+ Events, Event, State, Data, Result) ->
case Result of
stop ->
terminate(
- exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, normal, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason,NewData} ->
terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events]);
+ %%
{stop_and_reply,Reason,Replies} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events], Replies);
{stop_and_reply,Reason,Replies,NewData} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events], Replies);
+ %%
{next_state,State,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{next_state,NextState,NewData} when AllowStateChange ->
- {NewData,NextState,[]};
+ {NextState,NewData,[],true};
{next_state,State,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
{next_state,NextState,NewData,Actions} when AllowStateChange ->
- {NewData,NextState,Actions};
+ {NextState,NewData,Actions,true};
+ %%
{keep_state,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{keep_state,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
keep_state_and_data ->
- {Data,State,[]};
+ {State,Data,[],false};
{keep_state_and_data,Actions} ->
- {Data,State,Actions};
+ {State,Data,Actions,false};
+ %%
+ {repeat_state,NewData} ->
+ {State,NewData,[],true};
+ {repeat_state,NewData,Actions} ->
+ {State,NewData,Actions,true};
+ repeat_state_and_data ->
+ {State,Data,[],true};
+ {repeat_state_and_data,Actions} ->
+ {State,Data,Actions,true};
+ %%
_ ->
terminate(
error,
{bad_return_from_state_function,Result},
- ?STACKTRACE(),
- Debug, S, [Event|Events])
+ ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events])
end.
-parse_enter_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR) ->
+parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) ->
Postpone = forbidden,
NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
Hibernate, TimeoutsR, Postpone, NextEventsR).
-
+
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- TimeoutsR = [],
+ TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer
Postpone = false,
NextEventsR = [],
parse_actions(
@@ -1279,64 +1341,29 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
+ %%
%% Actions that set options
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
NewHibernate, TimeoutsR, Postpone, NextEventsR);
- {hibernate,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
hibernate ->
+ NewHibernate = true,
parse_actions(
Debug, S, State, Actions,
- true, TimeoutsR, Postpone, NextEventsR);
- {state_timeout,Time,_} = StateTimeout
- when is_integer(Time), Time >= 0;
- Time =:= infinity ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
- {state_timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- {timeout,infinity,_} ->
- %% Ignore - timeout will never happen and already cancelled
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
- {timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- infinity -> % Ignore - timeout will never happen
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- Time when is_integer(Time), Time >= 0 ->
- Timeout = {timeout,Time,Time},
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
+ %%
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
Hibernate, TimeoutsR, NewPostpone, NextEventsR);
- {postpone,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
postpone when Postpone =/= forbidden ->
+ NewPostpone = true,
parse_actions(
Debug, S, State, Actions,
- Hibernate, TimeoutsR, true, NextEventsR);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
+ %%
{next_event,Type,Content} ->
case event_type(Type) of
true when NextEventsR =/= forbidden ->
@@ -1351,96 +1378,150 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
- _ ->
+ %%
+ {state_timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ {timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ Time ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Time)
+ end.
+
+parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) ->
+ Time =
+ case Timeout of
+ {_,T,_} -> T;
+ T -> T
+ end,
+ case validate_time(Time) of
+ true ->
+ parse_actions(
+ Debug, S, State, Actions,
+ Hibernate, [Timeout|TimeoutsR],
+ Postpone, NextEventsR);
+ false ->
{error,
- {bad_action_from_state_function,Action},
+ {bad_action_from_state_function,Timeout},
?STACKTRACE()}
end.
+validate_time(Time) when is_integer(Time), Time >= 0 -> true;
+validate_time(infinity) -> true;
+validate_time(_) -> false.
%% Stop and start timers as well as create timeout zero events
%% and pending event timer
%%
%% Stop and start timers non-event timers
-parse_timers(TimerRefs, TimerTypes, TimeoutsR) ->
- parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []).
+parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) ->
+ parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []).
%%
-parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
- {TimerRefs,TimerTypes,TimeoutEvents};
parse_timers(
- TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
- {TimerType,Time,TimerMsg} = Timeout,
+ TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents};
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR],
+ Seen, TimeoutEvents) ->
+ case Timeout of
+ {TimerType,Time,TimerMsg} ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg);
+ Time ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ timeout, Time, Time)
+ end.
+
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg) ->
case Seen of
#{TimerType := _} ->
%% Type seen before - ignore
parse_timers(
- TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents);
#{} ->
%% Unseen type - handle
NewSeen = Seen#{TimerType => true},
- %% Cancel any running timer
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
- if
- Time =:= infinity ->
- %% Ignore - timer will never fire
+ case Time of
+ infinity ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, TimeoutEvents);
- TimerType =:= timeout ->
- %% Handle event timer later
- parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
- NewSeen, [Timeout|TimeoutEvents]);
- Time =:= 0 ->
+ 0 ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
%% Handle zero time timeouts later
TimeoutEvent = {TimerType,TimerMsg},
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, [TimeoutEvent|TimeoutEvents]);
- true ->
- %% Start a new timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- parse_timers(
- NewTimerRefs#{TimerRef => TimerType},
- NewTimerTypes#{TimerType => TimerRef},
- TimeoutsR, NewSeen, TimeoutEvents)
+ _ ->
+ %% (Re)start the timer
+ TimerRef =
+ erlang:start_timer(Time, self(), TimerMsg),
+ case TimerTypes of
+ #{TimerType := OldTimerRef} ->
+ %% Cancel the running timer
+ cancel_timer(OldTimerRef),
+ NewCancelTimers = CancelTimers + 1,
+ %% Insert the new timer into
+ %% both TimerRefs and TimerTypes
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ NewCancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents);
+ #{} ->
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ CancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents)
+ end
end
end.
-%% Enqueue immediate timeout events and start event timer
-process_timeout_events(TimerRefs, TimerTypes, [], EventsR) ->
- {TimerRefs, TimerTypes, EventsR};
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,0,TimerMsg}|TimeoutEvents], []) ->
- %% No enqueued events - insert a timeout zero event
- TimeoutEvent = {timeout,TimerMsg},
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent]);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,Time,TimerMsg}], []) ->
- %% No enqueued events - start event timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- process_timeout_events(
- TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef},
- [], []);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) ->
- %% There will be some other event so optimize by not starting
- %% an event timer to just have to cancel it again
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, EventsR);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) ->
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent|EventsR]).
+%% Enqueue immediate timeout events (timeout 0 events)
+%%
+%% Event timer timeout 0 events gets special treatment since
+%% an event timer is cancelled by any received event,
+%% so if there are enqueued events before the event timer
+%% timeout 0 event - the event timer is cancelled hence no event.
+%%
+%% Other (state_timeout) timeout 0 events that are after
+%% the event timer timeout 0 events are considered to
+%% belong to timers that were started after the event timer
+%% timeout 0 event fired, so they do not cancel the event timer.
+%%
+prepend_timeout_events([], EventsR) ->
+ EventsR;
+prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
+prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
+ prepend_timeout_events(TimeoutEvents, EventsR);
+prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
+ %% Just prepend all others
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).
@@ -1448,18 +1529,11 @@ process_timeout_events(
%% Server helpers
reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, #{state := State} = S, Q, Replies) ->
- if
- is_list(Replies) ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, Replies, State);
- true ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, [Replies], State)
- end.
+ Class, Reason, Stacktrace, Debug,
+ #{state := State} = S, Q, Replies) ->
+ do_reply_then_terminate(
+ Class, Reason, Stacktrace, Debug,
+ S, Q, listify(Replies), State).
%%
do_reply_then_terminate(
Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
@@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) ->
terminate(
- Class, Reason, Stacktrace,
- Debug,
+ Class, Reason, Stacktrace, Debug,
#{module := Module, state := State, data := Data, postponed := P} = S,
Q) ->
- try Module:terminate(Reason, State, Data) of
- _ -> ok
- catch
- _ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q, P,
- format_status(terminate, get(), S)),
- sys:print_log(Debug),
- erlang:raise(C, R, ST)
+ case erlang:function_exported(Module, terminate, 3) of
+ true ->
+ try Module:terminate(Reason, State, Data) of
+ _ -> ok
+ catch
+ _ -> ok;
+ C:R ->
+ ST = erlang:get_stacktrace(),
+ error_info(
+ C, R, ST, S, Q, P,
+ format_status(terminate, get(), S)),
+ sys:print_log(Debug),
+ erlang:raise(C, R, ST)
+ end;
+ false ->
+ ok
end,
_ =
case Reason of
@@ -1637,28 +1715,21 @@ listify(Item) ->
[Item].
%% Cancel timer if running, otherwise no op
-cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+%%
+%% This is an asynchronous cancel so the timer is not really cancelled
+%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}.
+%% In the mean time we might get a timeout message.
+%%
+%% Remove the timer from TimerTypes.
+%% When we get the cancel_timer msg we remove it from TimerRefs.
+cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) ->
case TimerTypes of
#{TimerType := TimerRef} ->
cancel_timer(TimerRef),
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)};
+ {maps:remove(TimerType, TimerTypes),CancelTimers + 1};
#{} ->
- {TimerRefs,TimerTypes}
+ {TimerTypes,CancelTimers}
end.
-%%cancel_timer(undefined) ->
-%% ok;
-cancel_timer(TRef) ->
- case erlang:cancel_timer(TRef) of
- false ->
- %% We have to assume that TRef is the ref of a running timer
- %% and if so the timer has expired
- %% hence we must wait for the timeout message
- receive
- {timeout,TRef,_} ->
- ok
- end;
- _TimeLeft ->
- ok
- end.
+cancel_timer(TimerRef) ->
+ ok = erlang:cancel_timer(TimerRef, [{async,true}]).
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 16ca2f41dc..ba2cffdcb3 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,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.
@@ -128,6 +128,10 @@ max_cs(M, _Len) ->
M.
-define(ATM(T), is_list(element(1, T))).
+-define(ATM_PAIR(Pair),
+ ?ATM(element(2, element(1, Pair))) % Key
+ andalso
+ ?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
@@ -140,9 +144,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}];
-pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)];
+ [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
+ $}];
pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
@@ -166,6 +169,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
[Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)]
end.
+pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "...";
+pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
+ {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
+ [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
+
+pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+ ",...";
+pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ [$,, write_pair(P) |
+ pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)];
+ true ->
+ {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0),
+ [$,, $\n, Ind, PS |
+ pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
+ end.
+
+pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ {write_pair(Pair), if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll % force nl
+ end};
+pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+ I = map_value_indent(TInd),
+ Ind = indent(I, Ind0),
+ {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
+ Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl
+
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
@@ -204,7 +247,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
end};
pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
- {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
+ Sep = case S of
+ [$\n | _] -> " =";
+ _ -> " = "
+ end,
+ {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
rec_indent(RInd, TInd, Col0, Ind0, W0) ->
Nl = (TInd > 0) and (RInd > TInd),
@@ -291,8 +338,8 @@ write({{list, L}, _}) ->
[$[, write_list(L, $|), $]];
write({{map, Pairs}, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, K, V}, _}) ->
- [write(K)," => ",write(V)];
+write({{map_pair, _K, _V}, _}=Pair) ->
+ write_pair(Pair);
write({{record, [{Name,_} | L]}, _}) ->
[Name, ${, write_fields(L), $}];
write({{bin, S}, _}) ->
@@ -300,6 +347,9 @@ write({{bin, S}, _}) ->
write({S, _}) ->
S.
+write_pair({{map_pair, K, V}, _}) ->
+ [write(K), " => ", write(V)].
+
write_fields([]) ->
"";
write_fields({dots, _}) ->
@@ -333,7 +383,7 @@ write_tail(E, S) ->
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
-%% format can be formatted. The separators (list, tuple, record) are
+%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
@@ -406,21 +456,32 @@ print_length(Term, _D, _RF, _Enc, _Str) ->
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str),
+ Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str),
{{map, Pairs}, list_length(Pairs, 3)}.
+maps_to_list(Map, D) when D < 0; map_size(Map) =< D ->
+ maps:to_list(Map);
+maps_to_list(Map, D) ->
+ F = fun(_K, _V, {N, L}) when N =:= D ->
+ throw(L);
+ (K, V, {N, L}) ->
+ {N+1, [{K, V} | L]}
+ end,
+ lists:reverse(catch maps:fold(F, {0, []}, Map)).
+
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
{dots, 3};
-print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K,V,D-1,RF,Enc,Str) |
- print_length_map_pairs(Pairs,D-1,RF,Enc,Str)].
+print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
+ [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
+ print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
print_length_map_pair(K, V, D, RF, Enc, Str) ->
{KS, KL} = print_length(K, D, RF, Enc, Str),
{VS, VL} = print_length(V, D, RF, Enc, Str),
- {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}.
+ KL1 = KL + 4,
+ {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
{"{...}", 5};
@@ -612,6 +673,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
+cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+ cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
@@ -637,6 +700,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
throw(no_good)
end.
+cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
+ PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
+ cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
+cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen);
+ true ->
+ PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0),
+ cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW)
+ end;
+cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll
+ end;
+cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+ cind(K, Col0, Ll, M, Ind, LD, W0),
+ I = map_value_indent(Ind),
+ cind(V, Col0 + I, Ll, M, Ind, LD, 0),
+ Ll.
+
+map_value_indent(TInd) ->
+ case TInd > 0 of
+ true ->
+ TInd;
+ false ->
+ 4
+ end.
+
cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
Nind = Nlen + 1,
{Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0),
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index f3665824f2..8c4d835432 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) ->
end;
abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) ->
{special, Line, lists:flatten(io_lib:write(PPR))};
+abstr_term(Map, Line) when is_map(Map) ->
+ {map,Line,
+ [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} ||
+ {K,V} <- maps:to_list(Map)]};
abstr_term(Simple, Line) ->
erl_parse:abstract(Simple, erl_anno:line(Line)).
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 340cc21390..fadf96146e 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -179,19 +179,6 @@
external_attr,
local_header_offset}).
-%% Unix extra fields (not yet supported)
--define(UNIX_EXTRA_FIELD_TAG, 16#000d).
--record(unix_extra_field, {atime,
- mtime,
- uid,
- gid}).
-
-%% extended timestamps (not yet supported)
--define(EXTENDED_TIMESTAMP_TAG, 16#5455).
-%% -record(extended_timestamp, {mtime,
-%% atime,
-%% ctime}).
-
-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50).
-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
@@ -381,9 +368,12 @@ do_unzip(F, Options) ->
{Info, In1} = get_central_dir(In0, RawIterator, Input),
%% get rid of zip-comment
Z = zlib:open(),
- Files = get_z_files(Info, Z, In1, Opts, []),
- zlib:close(Z),
- Input(close, In1),
+ Files = try
+ get_z_files(Info, Z, In1, Opts, [])
+ after
+ zlib:close(Z),
+ Input(close, In1)
+ end,
{ok, Files}.
%% Iterate over all files in a zip archive
@@ -460,11 +450,20 @@ do_zip(F, Files, Options) ->
#zip_opts{output = Output, open_opts = OpO} = Opts,
Out0 = Output({open, F, OpO}, []),
Z = zlib:open(),
- {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
- zlib:close(Z),
- Out2 = put_central_dir(LHS, Pos, Out1, Opts),
- Out3 = Output({close, F}, Out2),
- {ok, Out3}.
+ try
+ {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
+ zlib:close(Z),
+ Out2 = put_central_dir(LHS, Pos, Out1, Opts),
+ Out3 = Output({close, F}, Out2),
+ {ok, Out3}
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ zlib:close(Z),
+ Output({close, F}, Out0),
+ erlang:raise(C, R, Stk)
+ end.
+
%% List zip directory contents
%%
@@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName,
gid = 0},
add_extra_info(FI, ExtraField).
-%% add extra info to file (some day when we implement it)
-add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) ->
- FI; % not yet supported, some other day...
-add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) ->
- _UnixExtra = unix_extra_field_and_var_from_bin(Rest),
- FI; % not yet supported, and not widely used
+%% Currently, we ignore all the extra fields.
add_extra_info(FI, _) ->
FI.
@@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) ->
<<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>,
{DosDate, DosTime}.
-unix_extra_field_and_var_from_bin(<<TSize:16/little,
- ATime:32/little,
- MTime:32/little,
- UID:16/little,
- GID:16/little,
- Var:TSize/binary>>) ->
- {#unix_extra_field{atime = ATime,
- mtime = MTime,
- uid = UID,
- gid = GID},
- Var};
-unix_extra_field_and_var_from_bin(_) ->
- throw(bad_unix_extra_field).
-
%% A pwrite-like function for iolists (used by memory-option)
pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos ->
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index 718d91c6a3..1f694ea549 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-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.
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_testcase/2, end_per_testcase/2,
init_per_group/2,end_per_group/2]).
--export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]).
+-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1,
+ erl_352/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +37,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [normal, quoted_fun, quoted_module, quoted_both, erl_1152].
+ [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352].
groups() ->
[].
@@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) ->
"\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]),
ok.
+erl_352(Config) when is_list(Config) ->
+ erl_352_test(3, 3),
+
+ erl_352_test(3, 75),
+ erl_352_test(3, 76, [trailing]),
+ erl_352_test(4, 74),
+ erl_352_test(4, 75, [leading]),
+ erl_352_test(4, 76, [leading, trailing]),
+
+ erl_352_test(75, 3),
+ erl_352_test(76, 3, [leading]),
+ erl_352_test(74, 4),
+ erl_352_test(75, 4, [leading]),
+ erl_352_test(76, 4, [leading]),
+
+ erl_352_test(74, 74, [leading]),
+ erl_352_test(74, 75, [leading]),
+ erl_352_test(74, 76, [leading, trailing]).
+
+erl_352_test(PrefixLen, SuffixLen) ->
+ erl_352_test(PrefixLen, SuffixLen, []).
+
+erl_352_test(PrefixLen, SuffixLen, Dots) ->
+ io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]),
+
+ PrefixM = lists:duplicate(PrefixLen, $p),
+ SuffixM = lists:duplicate(SuffixLen, $s),
+ LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]],
+ StrM = do_format(LM),
+ check_leading(StrM, "", PrefixM, SuffixM, Dots),
+
+ PrefixF = lists:duplicate(PrefixLen, $p),
+ SuffixF = lists:duplicate(SuffixLen-2, $s),
+ LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]],
+ StrF = do_format(LF),
+ true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots),
+
+ ok.
+
+check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) ->
+ List = string:tokens(FormStr, "\n "),
+ io:format("~p\n", [List]),
+ true = lists:all(fun(L) -> length(L) < 80 end, List),
+ case lists:member(leading, Dots) of
+ true ->
+ true = lists:all(fun(L) ->
+ {"...", Rest} = lists:split(3, L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List);
+ false ->
+ true = lists:all(fun(L) ->
+ {Prefix, Rest} =
+ lists:split(length(Prefix), L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List)
+ end.
+
+check_trailing([I|Str], ArityStr, Suffix, Dots) ->
+ true = lists:member(I, [$1, $2]),
+ case lists:member(trailing, Dots) of
+ true ->
+ {Rest, "..." ++ ArityStr} =
+ lists:split(length(Str) - (3 + length(ArityStr)), Str),
+ true = lists:prefix(Rest, Suffix);
+ false ->
+ {Rest, ArityStr} =
+ lists:split(length(Str) - length(ArityStr), Str),
+ Rest =:= Suffix
+ end.
+
do_expand(String) ->
edlin_expand:expand(lists:reverse(String)).
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/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index b7c4d3a6e5..f64ec6acb7 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,6 +29,7 @@
dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]).
-export([pathtype_bin/1,rootname_bin/1,split_bin/1]).
-export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]).
+-export([safe_relative_path/1]).
-include_lib("common_test/include/ct.hrl").
@@ -41,7 +42,8 @@ all() ->
find_src,
absname_bin, absname_bin_2,
{group,p},
- t_basedir_xdg, t_basedir_windows].
+ t_basedir_xdg, t_basedir_windows,
+ safe_relative_path].
groups() ->
[{p, [parallel],
@@ -768,6 +770,71 @@ t_nativename_bin(Config) when is_list(Config) ->
filename:nativename(<<"/usr/tmp//arne/">>)
end.
+safe_relative_path(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Root = filename:join(PrivDir, ?FUNCTION_NAME),
+ ok = file:make_dir(Root),
+ ok = file:set_cwd(Root),
+
+ ok = file:make_dir("a"),
+ ok = file:set_cwd("a"),
+ ok = file:make_dir("b"),
+ ok = file:set_cwd("b"),
+ ok = file:make_dir("c"),
+
+ ok = file:set_cwd(Root),
+
+ "a" = test_srp("a"),
+ "a/b" = test_srp("a/b"),
+ "a/b" = test_srp("a/./b"),
+ "a/b" = test_srp("a/./b/."),
+
+ "" = test_srp("a/.."),
+ "" = test_srp("a/./.."),
+ "" = test_srp("a/../."),
+ "a" = test_srp("a/b/.."),
+ "a" = test_srp("a/../a"),
+ "a" = test_srp("a/../a/../a"),
+ "a/b/c" = test_srp("a/../a/b/c"),
+
+ unsafe = test_srp("a/../.."),
+ unsafe = test_srp("a/../../.."),
+ unsafe = test_srp("a/./../.."),
+ unsafe = test_srp("a/././../../.."),
+ unsafe = test_srp("a/b/././../../.."),
+
+ unsafe = test_srp(PrivDir), %Absolute path.
+
+ ok.
+
+test_srp(RelPath) ->
+ Res = do_test_srp(RelPath),
+ Res = case do_test_srp(list_to_binary(RelPath)) of
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin);
+ Other ->
+ Other
+ end.
+
+do_test_srp(RelPath) ->
+ {ok,Root} = file:get_cwd(),
+ ok = file:set_cwd(RelPath),
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Root),
+ case filename:safe_relative_path(RelPath) of
+ unsafe ->
+ true = length(Cwd) < length(Root),
+ unsafe;
+ "" ->
+ "";
+ SafeRelPath ->
+ ok = file:set_cwd(SafeRelPath),
+ {ok,Cwd} = file:get_cwd(),
+ true = length(Cwd) >= length(Root),
+ ok = file:set_cwd(Root),
+ SafeRelPath
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% basedirs
t_basedir_api(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 119546be98..24f0864b3c 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -38,7 +38,7 @@ all() ->
{group, abnormal},
{group, abnormal_handle_event},
shutdown, stop_and_reply, state_enter, event_order,
- state_timeout, code_change,
+ state_timeout, event_types, code_change,
{group, sys},
hibernate, enter_loop].
@@ -600,15 +600,26 @@ state_enter(_Config) ->
(internal, Prev, N) ->
Self ! {internal,start,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state,N + 1,
+ [{reply,From,{repeat,start,N}}]};
({call,From}, echo, N) ->
- {next_state,wait,N + 1,{reply,From,{echo,start,N}}};
+ {next_state,wait,N + 1,
+ {reply,From,{echo,start,N}}};
({call,From}, {stop,Reason}, N) ->
- {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1}
+ {stop_and_reply,Reason,
+ [{reply,From,{stop,N}}],N + 1}
end,
wait =>
- fun (enter, Prev, N) ->
+ fun (enter, Prev, N) when N < 5 ->
+ {repeat_state,N + 1,
+ {reply,{Self,N},{enter,Prev}}};
+ (enter, Prev, N) ->
Self ! {enter,wait,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state_and_data,
+ [{reply,From,{repeat,wait,N}}]};
({call,From}, echo, N) ->
{next_state,start,N + 1,
[{next_event,internal,wait},
@@ -620,11 +631,15 @@ state_enter(_Config) ->
[{enter,start,start,1}] = flush(),
{echo,start,2} = gen_statem:call(STM, echo),
- [{enter,wait,start,3}] = flush(),
- {wait,[4|_]} = sys:get_state(STM),
- {echo,wait,4} = gen_statem:call(STM, echo),
- [{enter,start,wait,5},{internal,start,wait,6}] = flush(),
- {stop,7} = gen_statem:call(STM, {stop,bye}),
+ [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(),
+ {wait,[6|_]} = sys:get_state(STM),
+ {repeat,wait,6} = gen_statem:call(STM, repeat),
+ [{enter,wait,wait,6}] = flush(),
+ {echo,wait,7} = gen_statem:call(STM, echo),
+ [{enter,start,wait,8},{internal,start,wait,9}] = flush(),
+ {repeat,start,10} = gen_statem:call(STM, repeat),
+ [{enter,start,start,11}] = flush(),
+ {stop,12} = gen_statem:call(STM, {stop,bye}),
[{'EXIT',STM,bye}] = flush(),
{noproc,_} =
@@ -801,6 +816,74 @@ state_timeout(_Config) ->
+%% Test that all event types can be sent with {next_event,EventType,_}
+event_types(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ %% Abusing the internal format of From...
+ #{init =>
+ fun () ->
+ {ok, start, undefined}
+ end,
+ start =>
+ fun ({call,_} = Call, Req, undefined) ->
+ {next_state, state1, undefined,
+ [{next_event,internal,1},
+ {next_event,state_timeout,2},
+ {next_event,timeout,3},
+ {next_event,info,4},
+ {next_event,cast,5},
+ {next_event,Call,Req}]}
+ end,
+ state1 =>
+ fun (internal, 1, undefined) ->
+ {next_state, state2, undefined}
+ end,
+ state2 =>
+ fun (state_timeout, 2, undefined) ->
+ {next_state, state3, undefined}
+ end,
+ state3 =>
+ fun (timeout, 3, undefined) ->
+ {next_state, state4, undefined}
+ end,
+ state4 =>
+ fun (info, 4, undefined) ->
+ {next_state, state5, undefined}
+ end,
+ state5 =>
+ fun (cast, 5, undefined) ->
+ {next_state, state6, undefined}
+ end,
+ state6 =>
+ fun ({call,From}, stop, undefined) ->
+ {stop_and_reply, shutdown,
+ [{reply,From,stopped}]}
+ end},
+ {ok,STM} =
+ gen_statem:start_link(
+ ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]),
+
+ stopped = gen_statem:call(STM, stop),
+ receive
+ {'EXIT',STM,shutdown} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ {noproc,_} =
+ ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason),
+ case flush() of
+ [] ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected,Other2})
+ end.
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),
@@ -1722,6 +1805,10 @@ handle_event(
{keep_state,[NewData|Machine]};
{keep_state,NewData,Ops} ->
{keep_state,[NewData|Machine],Ops};
+ {repeat_state,NewData} ->
+ {repeat_state,[NewData|Machine]};
+ {repeat_state,NewData,Ops} ->
+ {repeat_state,[NewData|Machine],Ops};
Other ->
Other
end;
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 7d48cbc97c..6e99619324 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -30,7 +30,7 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1]).
+ maps/1, coverage/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage].
+ format_string, maps, coverage, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2106,3 +2106,200 @@ coverage(_Config) ->
io:format("~s\n", [S2]),
ok.
+
+otp_14175(_Config) ->
+ "..." = p(#{}, 0),
+ "#{}" = p(#{}, 1),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 2bd940020c..846c2c56f4 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -869,11 +869,12 @@ eval_unique(Config) when is_list(Config) ->
[a] = qlc:e(Q2, {unique_all, true})
">>,
- <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)],
+ <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]],
+ unique)],
unique),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
qlc:info(Q, [{format,abstract_code},unique_all]),
- [1,2] = qlc:e(Q)">>,
+ [1,2,#{a := 1}] = qlc:e(Q)">>,
<<"Q = qlc:q([X || X <- [1,2,1]]),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
@@ -2620,7 +2621,16 @@ info(Config) when is_list(Config) ->
{cons, _, _, _}]},
{nil,_}}]}]} = i(QH, {format, abstract_code}),
[{5},{6}] = qlc:e(QH),
- [{4},{5},{6}] = qlc:e(F(3))">>
+ [{4},{5},{6}] = qlc:e(F(3))">>,
+
+ <<"Fun = fun ?MODULE:i/2,
+ L = [{#{k => #{v => Fun}}, Fun}],
+ H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
+ L = qlc:e(H),
+ {call,_,_,[{lc,_,{var,_,'Q'},
+ [{generate,_,_,_},
+ {op,_,_,_,_}]}]} =
+ qlc:info(H, [{format,abstract_code}])">>
],
run(Config, Ts),
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/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 7d90795c9e..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -27,7 +27,7 @@
openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
unzip_traversal_exploit/1,
compress_control/1,
- foldl/1]).
+ foldl/1,fd_leak/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -40,7 +40,7 @@ all() ->
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
zip_api, open_leak, unzip_jar, compress_control, foldl,
- unzip_traversal_exploit].
+ unzip_traversal_exploit,fd_leak].
groups() ->
[].
@@ -882,3 +882,35 @@ foldl(Config) ->
{error, enoent} = zip:foldl(ZipFun, [], File),
ok.
+
+fd_leak(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "bad_file_header.zip"),
+ BadExtract = fun() ->
+ {error,bad_file_header} = zip:extract(Name),
+ ok
+ end,
+ do_fd_leak(BadExtract, 1),
+
+ BadCreate = fun() ->
+ {error,enoent} = zip:zip("failed.zip",
+ ["none"]),
+ ok
+ end,
+ do_fd_leak(BadCreate, 1),
+
+ ok.
+
+do_fd_leak(_Bad, 10000) ->
+ ok;
+do_fd_leak(Bad, N) ->
+ try Bad() of
+ ok ->
+ do_fd_leak(Bad, N + 1)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Bad error after ~p attempts\n", [N]),
+ erlang:raise(C, R, Stk)
+ end.
diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el
index 2801aa8ae7..241590b850 100644
--- a/lib/tools/emacs/erlang-edoc.el
+++ b/lib/tools/emacs/erlang-edoc.el
@@ -36,7 +36,7 @@
"Tags that can be used anywhere within a module.")
(defvar erlang-edoc-overview-tags
- '("author" "copyright" "reference" "see" "since" "title" "version")
+ '("author" "copyright" "doc" "reference" "see" "since" "title" "version")
"Tags that can be used in an overview file.")
(defvar erlang-edoc-module-tags
@@ -45,8 +45,8 @@
"Tags that can be used before a module declaration.")
(defvar erlang-edoc-function-tags
- '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec"
- "throws" "type")
+ '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns"
+ "see" "since" "spec" "throws" "type")
"Tags that can be used before a function definition.")
(defvar erlang-edoc-predefined-macros
diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el
index eeba7f34e9..bdb3d9ad4a 100644
--- a/lib/tools/emacs/erlang-skels.el
+++ b/lib/tools/emacs/erlang-skels.el
@@ -1,7 +1,7 @@
;;
;; %CopyrightBegin%
;;
-;; Copyright Ericsson AB 2010-2016. All Rights Reserved.
+;; Copyright Ericsson AB 2010-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.
@@ -915,11 +915,7 @@ Please see the function `tempo-define-template'.")
"%% process to initialize." n
(erlang-skel-separator-end 2)
"-spec init(Args :: term()) ->" n>
- "{ok, State :: term(), Data :: term()} |" n>
- "{ok, State :: term(), Data :: term()," n>
- "[gen_statem:action()] | gen_statem:action()} |" n>
- "ignore |" n>
- "{stop, Reason :: term()}." n
+ "gen_statem:init_result(atom())." n
"init([]) ->" n>
"process_flag(trap_exit, true)," n>
"{ok, state_name, #data{}}." n
@@ -1028,11 +1024,7 @@ Please see the function `tempo-define-template'.")
"%% process to initialize." n
(erlang-skel-separator-end 2)
"-spec init(Args :: term()) ->" n>
- "{ok, State :: term(), Data :: term()} |" n>
- "{ok, State :: term(), Data :: term()," n>
- "[gen_statem:action()] | gen_statem:action()} |" n>
- "ignore |" n>
- "{stop, Reason :: term()}." n
+ "gen_statem:init_result(term())." n
"init([]) ->" n>
"process_flag(trap_exit, true)," n>
"{ok, state_name, #data{}}." n
diff --git a/lib/tools/examples/xref_examples.erl b/lib/tools/examples/xref_examples.erl
index 4c082195a2..f7e71c9708 100644
--- a/lib/tools/examples/xref_examples.erl
+++ b/lib/tools/examples/xref_examples.erl
@@ -7,7 +7,7 @@
%% ${HOME}/unused_locals.txt.
script() ->
Root = code:root_dir(),
- Dir = os:getenv("HOME"),
+ {ok,[[Dir]]} = init:get_argument(home),
Server = s,
xref:start(Server),
{ok, _Relname} = xref:add_release(Server, code:lib_dir(), {name,otp}),
diff --git a/lib/typer/src/typer.app.src b/lib/typer/src/typer.app.src
index 974091b44c..e0be937cc3 100644
--- a/lib/typer/src/typer.app.src
+++ b/lib/typer/src/typer.app.src
@@ -7,5 +7,5 @@
{registered, []},
{applications, [compiler, dialyzer, hipe, kernel, stdlib]},
{env, []},
- {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0",
- "dialyzer-2.7","compiler-5.0"]}]}.
+ {runtime_dependencies, ["stdlib-3.0","kernel-5.0","hipe-3.15.4","erts-8.0",
+ "dialyzer-3.1","compiler-7.0"]}]}.
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_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl
index 318a0cf7f4..1aef6c58c4 100644
--- a/lib/xmerl/src/xmerl_sax_parser.erl
+++ b/lib/xmerl/src/xmerl_sax_parser.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -33,6 +33,7 @@
%% External exports
%%----------------------------------------------------------------------
-export([file/2,
+ stream/3,
stream/2]).
%%----------------------------------------------------------------------
@@ -72,11 +73,12 @@ file(Name,Options) ->
File = filename:basename(Name),
ContinuationFun = fun default_continuation_cb/1,
Res = stream(<<>>,
- [{continuation_fun, ContinuationFun},
- {continuation_state, FD},
- {current_location, CL},
- {entity, File}
- |Options]),
+ [{continuation_fun, ContinuationFun},
+ {continuation_state, FD},
+ {current_location, CL},
+ {entity, File}
+ |Options],
+ file),
ok = file:close(FD),
Res
end.
@@ -92,19 +94,22 @@ file(Name,Options) ->
%% EventState = term()
%% Description: Parse a stream containing an XML document.
%%----------------------------------------------------------------------
-stream(Xml, Options) when is_list(Xml), is_list(Options) ->
+stream(Xml, Options) ->
+ stream(Xml, Options, stream).
+
+stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) ->
State = parse_options(Options, initial_state()),
- case State#xmerl_sax_parser_state.file_type of
+ case State#xmerl_sax_parser_state.file_type of
dtd ->
xmerl_sax_parser_list:parse_dtd(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream});
+ input_type = InputType});
normal ->
xmerl_sax_parser_list:parse(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream})
+ input_type = InputType})
end;
-stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
+stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) ->
case parse_options(Options, initial_state()) of
{error, Reason} -> {error, Reason};
State ->
@@ -127,7 +132,7 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
State#xmerl_sax_parser_state.event_state};
{Xml1, State1} ->
parse_binary(Xml1,
- State1#xmerl_sax_parser_state{input_type = stream},
+ State1#xmerl_sax_parser_state{input_type = InputType},
ParseFunction)
end
end.
@@ -226,12 +231,12 @@ check_encoding_option(E) ->
%% Description: Detects which character set is used in a binary stream.
%%----------------------------------------------------------------------
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) ->
- throw({error, "Can't detect character encoding due to no indata"});
+ {error, "Can't detect character encoding due to no indata"};
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = CFun,
continuation_state = CState} = State) ->
case CFun(CState) of
{<<>>, _} ->
- throw({error, "Can't detect character encoding due to lack of indata"});
+ {error, "Can't detect character encoding due to lack of indata"};
{NewBytes, NewContState} ->
detect_charset(NewBytes, State#xmerl_sax_parser_state{continuation_state = NewContState})
end;
diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl
index 932ab0cec5..7f9bf6c4d3 100644
--- a/lib/xmerl/src/xmerl_sax_parser.hrl
+++ b/lib/xmerl/src/xmerl_sax_parser.hrl
@@ -88,14 +88,7 @@
current_location, % Location of the currently parsed XML entity
entity, % Parsed XML entity
skip_external_dtd = false,% If true the external DTD is skipped during parsing
- input_type % Source type: file | stream.
- % This field is a preparation for an fix in R17 of a bug in
- % the conformance against the standard.
- % Today a file which contains two XML documents will be considered
- % well-formed and the second is placed in the rest part of the
- % return tuple, according to the conformance tests this should fail.
- % In the future this will fail if xmerl_sax_aprser:file/2 is used but
- % left to the user in the xmerl_sax_aprser:stream/2 case.
+ input_type % Source type: file | stream
}).
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index 4d75805b9b..f3470b2809 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -1,7 +1,7 @@
%%-*-erlang-*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -72,7 +72,12 @@ parse(Xml, State) ->
{ok, Rest, State2} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ case check_if_rest_ok(State3#xmerl_sax_parser_state.input_type, Rest) of
+ true ->
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ false ->
+ format_error(fatal_error, State3, "Input found after legal document")
+ end;
{fatal_error, {State2, Reason}} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -81,10 +86,14 @@ parse(Xml, State) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
format_error(Tag, State3, Reason);
+ {endDocument, Rest, State2} ->
+ State3 = event_callback(endDocument, State2),
+ ets:delete(RefTable),
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
%%----------------------------------------------------------------------
@@ -111,7 +120,7 @@ parse_dtd(Xml, State) ->
{Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
{endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -119,7 +128,7 @@ parse_dtd(Xml, State) ->
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
@@ -136,10 +145,11 @@ parse_dtd(Xml, State) ->
%% [1] document ::= prolog element Misc*
%%----------------------------------------------------------------------
parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) ->
- {Rest1, State1} = parse_xml_decl(Rest, State),
+ {Rest1, State1} = parse_byte_order_mark(Rest, State),
{Rest2, State2} = parse_misc(Rest1, State1, true),
{ok, Rest2, State2}.
+?PARSE_BYTE_ORDER_MARK(Bytes, State).
%%----------------------------------------------------------------------
%% Function: parse_xml_decl(Rest, State) -> Result
@@ -150,15 +160,8 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) ->
%% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
%% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
%%----------------------------------------------------------------------
--dialyzer({[no_fail_call, no_match], parse_xml_decl/2}).
parse_xml_decl(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_1, State) ->
- cf(?BYTE_ORDER_MARK_1, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_2, State) ->
- cf(?BYTE_ORDER_MARK_2, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_REST(Rest), State) ->
- cf(Rest, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING("<") = Bytes, State) ->
cf(Bytes, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING("<?") = Bytes, State) ->
@@ -170,31 +173,19 @@ parse_xml_decl(?STRING("<?xm") = Bytes, State) ->
parse_xml_decl(?STRING("<?xml") = Bytes, State) ->
cf(Bytes, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING_REST("<?xml", Rest1), State) ->
- parse_xml_decl_1(Rest1, State);
-parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
- case unicode:characters_to_list(Bytes, Enc) of
- {incomplete, _, _} ->
- cf(Bytes, State, fun parse_xml_decl/2);
- {error, _Encoded, _Rest} ->
- ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
- _ ->
- parse_prolog(Bytes, State)
- end;
-parse_xml_decl(Bytes, State) ->
- parse_prolog(Bytes, State).
-
+ parse_xml_decl_rest(Rest1, State);
+?PARSE_XML_DECL(Bytes, State).
-parse_xml_decl_1(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) ->
+parse_xml_decl_rest(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) ->
if
?is_whitespace(C) ->
{_XmlAttributes, Rest1, State1} = parse_version_info(Rest, State, []),
- %State2 = event_callback({processingInstruction, "xml", XmlAttributes}, State1),% The XML decl. should not be reported as a PI
parse_prolog(Rest1, State1);
true ->
parse_prolog(?STRING_REST("<?xml", Bytes), State)
end;
-parse_xml_decl_1(Bytes, State) ->
- unicode_incomplete_check([Bytes, State, fun parse_xml_decl_1/2], undefined).
+parse_xml_decl_rest(Bytes, State) ->
+ unicode_incomplete_check([Bytes, State, fun parse_xml_decl_rest/2], undefined).
@@ -216,8 +207,6 @@ parse_prolog(?STRING_REST("<?", Rest), State) ->
parse_prolog(Rest1, State1);
{endDocument, Rest1, State1} ->
parse_prolog(Rest1, State1)
- % IValue = ?TO_INPUT_FORMAT("<?"),
- % {?APPEND_STRING(IValue, Rest1), State1}
end;
parse_prolog(?STRING_REST("<!", Rest), State) ->
parse_prolog_1(Rest, State);
@@ -230,7 +219,6 @@ parse_prolog(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_prolog/2],
"expecting < or whitespace").
-
parse_prolog_1(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_prolog_1/2);
parse_prolog_1(?STRING("D") = Bytes, State) ->
@@ -442,6 +430,15 @@ check_if_new_doc_allowed(stream, []) ->
check_if_new_doc_allowed(_, _) ->
false.
+check_if_rest_ok(file, []) ->
+ true;
+check_if_rest_ok(file, <<>>) ->
+ true;
+check_if_rest_ok(stream, _) ->
+ true;
+check_if_rest_ok(_, _) ->
+ false.
+
%%----------------------------------------------------------------------
%% Function: parse_pi_1(Rest, State) -> Result
%% Input: Rest = string() | binary()
@@ -1024,16 +1021,21 @@ parse_etag(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_etag/2],
undefined).
-
parse_etag_1(?STRING_REST(">", Rest),
#xmerl_sax_parser_state{end_tags=[{_ETag, Uri, LocalName, QName, OldNsList, NewNsList}
- |RestOfETags]} = State, _Tag) ->
+ |RestOfETags],
+ input_type=InputType} = State, _Tag) ->
State1 = event_callback({endElement, Uri, LocalName, QName}, State),
State2 = send_end_prefix_mapping_event(NewNsList, State1),
- parse_content(Rest,
- State2#xmerl_sax_parser_state{end_tags=RestOfETags,
- ns = OldNsList},
- [], true);
+ case check_if_new_doc_allowed(InputType, RestOfETags) of
+ true ->
+ throw({endDocument, Rest, State2#xmerl_sax_parser_state{ns = OldNsList}});
+ false ->
+ parse_content(Rest,
+ State2#xmerl_sax_parser_state{end_tags=RestOfETags,
+ ns = OldNsList},
+ [], true)
+ end;
parse_etag_1(?STRING_UNBOUND_REST(_C, _), State, Tag) ->
{P,TN} = Tag,
?fatal_error(State, "Bad EndTag: " ++ P ++ ":" ++ TN);
@@ -1051,21 +1053,26 @@ parse_etag_1(Bytes, State, Tag) ->
%% Description: Parsing the content part of tags
%% [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
%%----------------------------------------------------------------------
-
parse_content(?STRING_EMPTY, State, Acc, IgnorableWS) ->
- case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
- {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
- {Rest, State1};
- {fatal_error, {State1, Msg}} ->
- case check_if_document_complete(State1, Msg) of
- true ->
- State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
- {?STRING_EMPTY, State2};
- false ->
- ?fatal_error(State1, Msg)
- end;
- Other ->
- throw(Other)
+ case check_if_document_complete(State, "No more bytes") of
+ true ->
+ State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
+ {?STRING_EMPTY, State1};
+ false ->
+ case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
+ {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
+ {Rest, State1};
+ {fatal_error, {State1, Msg}} ->
+ case check_if_document_complete(State1, Msg) of
+ true ->
+ State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
+ {?STRING_EMPTY, State2};
+ false ->
+ ?fatal_error(State1, Msg)
+ end;
+ Other ->
+ throw(Other)
+ end
end;
parse_content(?STRING("\r") = Bytes, State, Acc, IgnorableWS) ->
cf(Bytes, State, Acc, IgnorableWS, fun parse_content/4);
@@ -1094,7 +1101,7 @@ parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) ->
parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_cdata(Rest1, State1)
@@ -1102,7 +1109,7 @@ parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags
parse_content(?STRING_REST("<", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_stag(Rest1, State1)
@@ -1204,7 +1211,6 @@ send_character_event(_, true, String, State) ->
%% Description: Parse whitespaces.
%% [3] S ::= (#x20 | #x9 | #xD | #xA)+
%%----------------------------------------------------------------------
--dialyzer({no_fail_call, whitespace/3}).
whitespace(?STRING_EMPTY, State, Acc) ->
case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of
{?STRING_EMPTY, State} ->
@@ -1230,16 +1236,7 @@ whitespace(?STRING_REST("\r", Rest), State, Acc) ->
whitespace(Rest, State#xmerl_sax_parser_state{line_no=N+1}, [?lf |Acc]);
whitespace(?STRING_UNBOUND_REST(C, Rest), State, Acc) when ?is_whitespace(C) ->
whitespace(Rest, State, [C|Acc]);
-whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
- {lists:reverse(Acc), Bytes, State};
-whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
- case unicode:characters_to_list(Bytes, Enc) of
- {incomplete, _, _} ->
- cf(Bytes, State, Acc, fun whitespace/3);
- {error, _Encoded, _Rest} ->
- ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
- end.
-
+?WHITESPACE(Bytes, State, Acc).
%%----------------------------------------------------------------------
%% Function: parse_reference(Rest, State, HaveToExist) -> Result
@@ -1362,7 +1359,6 @@ parse_pe_reference_1(Bytes, State, Name) ->
"missing ; after reference " ++ Name).
-
%%----------------------------------------------------------------------
%% Function: insert_reference(Reference, State) -> Result
%% Parameters: Reference = string()
@@ -1378,7 +1374,6 @@ insert_reference({Name, Type, Value}, Table) ->
end.
-
%%----------------------------------------------------------------------
%% Function: look_up_reference(Reference, State) -> Result
%% Parameters: Reference = string()
@@ -1693,7 +1688,7 @@ handle_external_entity({http, Url}, State) ->
++ file:format_error(Reason));
{ok, FD} ->
{?STRING_EMPTY, EntityState} =
- parse_external_entity_1(<<>>,
+ parse_external_entity_byte_order_mark(<<>>,
State#xmerl_sax_parser_state{continuation_state=FD,
current_location=filename:dirname(Url),
entity=filename:basename(Url),
@@ -1709,6 +1704,8 @@ handle_external_entity({http, Url}, State) ->
handle_external_entity({Tag, _Url}, State) ->
?fatal_error(State, "Unsupported URI type: " ++ atom_to_list(Tag)).
+?PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State).
+
%%----------------------------------------------------------------------
%% Function : parse_external_entity_1(Rest, State) -> Result
%% Parameters: Rest = string() | binary()
@@ -1716,7 +1713,6 @@ handle_external_entity({Tag, _Url}, State) ->
%% Result : {Rest, State}
%% Description: Parse the external entity.
%%----------------------------------------------------------------------
--dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}).
parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) ->
case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of
{Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
@@ -1726,12 +1722,6 @@ parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} =
Other ->
throw(Other)
end;
-parse_external_entity_1(?BYTE_ORDER_MARK_1, State) ->
- cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_1/2);
-parse_external_entity_1(?BYTE_ORDER_MARK_2, State) ->
- cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_1/2);
-parse_external_entity_1(?BYTE_ORDER_MARK_REST(Rest), State) ->
- parse_external_entity_1(Rest, State);
parse_external_entity_1(?STRING("<") = Bytes, State) ->
cf(Bytes, State, fun parse_external_entity_1/2);
parse_external_entity_1(?STRING("<?") = Bytes, State) ->
@@ -3290,7 +3280,7 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C
catch
throw:ErrorTerm ->
?fatal_error(State, ErrorTerm);
- exit:Reason ->
+ exit:Reason ->
?fatal_error(State, {'EXIT', Reason})
end,
case Result of
diff --git a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
index 961806bf4c..6e59347fb8 100644
--- a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -34,8 +34,36 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, latin1)).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, undefined_bom2).
--define(BYTE_ORDER_MARK_REST(Rest), <<undefined, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
index 624a621d92..6a4435b1d9 100644
--- a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
@@ -36,6 +36,19 @@
%% In the list case we can't use a '++' when matchin against an unbound variable
-define(STRING_UNBOUND_REST(MatchChar, Rest), [MatchChar | Rest]).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, undefined_bom2).
--define(BYTE_ORDER_MARK_REST(Rest), [undefined|Rest]).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State}).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
index ff84ece97a..ec89024729 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -34,8 +34,50 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, big})).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/big-utf16, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, <<16#FE>>).
+-define(BYTE_ORDER_MARK_1, <<16#FE>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#FE, 16#FF, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
index a330fce8d0..566333a045 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -34,8 +34,50 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, little})).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/little-utf16, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, <<16#FF>>).
+-define(BYTE_ORDER_MARK_1, <<16#FF>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#FF, 16#FE, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
index d46d60d237..f41d06d013 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -34,11 +34,55 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, utf8)).
-
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/utf8, Rest/binary>>).
-define(BYTE_ORDER_MARK_1, <<16#EF>>).
-define(BYTE_ORDER_MARK_2, <<16#EF, 16#BB>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#EF, 16#BB, 16#BF, Rest/binary>>).
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_2, State) ->
+ cf(?BYTE_ORDER_MARK_2, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_2, State) ->
+ cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl
index 5e0459ec21..95dc82e5c9 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,
@@ -2307,7 +2309,9 @@ expanded_name(Name, [], #xmlNamespace{default = URI}, S) ->
expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) ->
{_, Value} = lists:keyfind(Local, 1, Ns),
case Name of
- 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' ->
+ 'xmlns:xml' when Value =:= 'http://www.w3.org/XML/1998/namespace' ->
+ N;
+ 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' ->
?fatal({xml_prefix_cannot_be_redeclared, Value}, S);
'xmlns:xmlns' ->
?fatal({xmlns_prefix_cannot_be_declared, Value}, S);
@@ -2321,6 +2325,8 @@ expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) ->
N
end
end;
+expanded_name(_Name, {"xml", Local}, _NS, _S) ->
+ {'http://www.w3.org/XML/1998/namespace', list_to_atom(Local)};
expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) ->
case lists:keysearch(Prefix, 1, Ns) of
{value, {_, URI}} ->
@@ -2331,9 +2337,6 @@ expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) ->
?fatal({namespace_prefix_not_declared, Prefix}, S)
end.
-
-
-
keyreplaceadd(K, Pos, [H|T], Obj) when K == element(Pos, H) ->
[Obj|T];
keyreplaceadd(K, Pos, [H|T], Obj) ->
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index 7a326e334f..b13fee05b3 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -55,7 +55,8 @@ SUITE_FILES= \
xmerl_xsd_SUITE.erl \
xmerl_xsd_MS2002-01-16_SUITE.erl \
xmerl_xsd_NIST2002-01-16_SUITE.erl \
- xmerl_xsd_Sun2002-01-16_SUITE.erl
+ xmerl_xsd_Sun2002-01-16_SUITE.erl \
+ xmerl_sax_stream_SUITE.erl
XML_FILES= \
testcases.dtd \
@@ -125,4 +126,5 @@ release_tests_spec: opt
@tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
chmod -R u+w "$(RELSYSDIR)"
diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl
index e97b8c6a4b..58c462483c 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, xml_ns]},
{eventp_tests, [], [sax_parse_and_export]},
{ticket_tests, [],
[ticket_5998, ticket_7211, ticket_7214, ticket_7430,
@@ -223,6 +224,50 @@ 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}]),
+ ok.
+
+
+xml_ns(Config) ->
+ Doc = "<?xml version='1.0'?>\n"
+ "<doc xml:attr1=\"implicit xml ns\"/>",
+ {#xmlElement{namespace=#xmlNamespace{default = [], nodes = []},
+ attributes = [#xmlAttribute{name = 'xml:attr1',
+ expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1},
+ nsinfo = {"xml","attr1"},
+ namespace = #xmlNamespace{default = [], nodes = []}}]},
+ []
+ } = xmerl_scan:string(Doc, [{namespace_conformant, true}]),
+ Doc2 = "<?xml version='1.0'?>\n"
+ "<doc xmlns:xml=\"http://www.w3.org/XML/1998/namespace\" xml:attr1=\"explicit xml ns\"/>",
+ {#xmlElement{namespace=#xmlNamespace{default = [], nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]},
+ attributes = [#xmlAttribute{name = 'xmlns:xml',
+ expanded_name = {"xmlns","xml"},
+ nsinfo = {"xmlns","xml"},
+ namespace = #xmlNamespace{default = [],
+ nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}},
+ #xmlAttribute{name = 'xml:attr1',
+ expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1},
+ nsinfo = {"xml","attr1"},
+ namespace = #xmlNamespace{default = [],
+ nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}]},
+ []
+ } = xmerl_scan:string(Doc2, [{namespace_conformant, true}]),
+ ok.
+
pe_ref1(Config) ->
file:set_cwd(datadir(Config)),
{#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]).
diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index f5c0a783c4..7d1a70905c 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -85,17 +85,17 @@ ticket_11551(_Config) ->
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
+ {ok, undefined, <<"\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
+ {ok, undefined, <<"\n\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
Stream3= <<"<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
+ {ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
ok.
diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
index 525a3b175a..b8412206cc 100644
--- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
@@ -2,7 +2,7 @@
%%----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-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.
@@ -507,11 +507,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-036'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/036.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -522,11 +519,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-037'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/037.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&#32;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -561,11 +555,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-040'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/040.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -576,11 +567,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-041'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/041.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -603,11 +591,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-043'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/043.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -618,11 +603,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-044'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/044.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc/>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -669,11 +651,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-048'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/048.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<![CDATA[]]>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1416,11 +1395,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-110'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/110.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&e;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1914,9 +1890,9 @@ end_per_testcase(_Func,_Config) ->
%% Special case becase we returns everything after a legal document
%% as an rest instead of giving and error to let the user handle
%% multipple docs on a stream.
- {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ %{ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -7784,11 +7760,8 @@ end_per_testcase(_Func,_Config) ->
'o-p01fail3'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"oasis","p01fail3.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<bad/>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11417,12 +11390,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n02'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n02.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11433,11 +11402,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n03'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n03.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<title>Wrong combination!</title>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13027,11 +12993,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P27-ibm27n01'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P27/ibm27n01.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<!ELEMENT cat EMPTY>">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13461,11 +13424,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P39-ibm39n06'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P39/ibm39n06.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"content after end tag\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
new file mode 100644
index 0000000000..a306eb66a2
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
@@ -0,0 +1,245 @@
+%%-*-erlang-*-
+%%----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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.
+%% 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%
+%%----------------------------------------------------------------------
+%% File : xmerl_sax_stream_SUITE.erl
+%%----------------------------------------------------------------------
+-module(xmerl_sax_stream_SUITE).
+-compile(export_all).
+
+%%----------------------------------------------------------------------
+%% Include files
+%%----------------------------------------------------------------------
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/file.hrl").
+
+%%======================================================================
+%% External functions
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+all() ->
+ [
+ one_document,
+ two_documents,
+ one_document_and_junk
+ ].
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+one_document(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n">> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+two_documents(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_two.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n<?x", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+one_document_and_junk(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one_junk.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\nth", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 10000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+%%----------------------------------------------------------------------
+%% Utility functions
+%%----------------------------------------------------------------------
+listen(Port) ->
+ case catch gen_tcp:listen(Port, [{active, false},
+ binary,
+ {keepalive, true},
+ {reuseaddr,true}]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket};
+ {error, Reason} ->
+ {error, {listen, Reason}}
+ end.
+
+close(Socket) ->
+ (catch gen_tcp:close(Socket)).
+
+connect(Host, Port) ->
+ Timeout = 5000,
+ % Options1 = check_options(Options),
+ Options = [binary],
+ case catch gen_tcp:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ {ok, Socket};
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+send_chunks(Socket, Binary) ->
+ BSize = erlang:size(Binary),
+ if
+ BSize > 25 ->
+ <<Head:25/binary, Tail/binary>> = Binary,
+ case gen_tcp:send(Socket, Head) of
+ ok ->
+ timer:sleep(1000),
+ send_chunks(Socket, Tail);
+ {error,closed} ->
+ ok
+ end;
+ true ->
+ gen_tcp:send(Socket, Binary)
+ end.
+
+datadir(Config) ->
+ proplists:get_value(data_dir, Config).
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
new file mode 100644
index 0000000000..30328bb188
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
new file mode 100644
index 0000000000..f730a95865
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+this is junk ......
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
new file mode 100644
index 0000000000..e241a02190
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+<?xml version="1.0"?>
+<person>
+<name>
+Bertil Bengtson
+</name>
+<address>
+<street>
+ New Road 4
+</street>
+<zip>
+12328
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
diff --git a/otp_build b/otp_build
index 28a229b101..d0f75aff71 100755
--- a/otp_build
+++ b/otp_build
@@ -19,9 +19,6 @@
# %CopyrightEnd%
#
-# Expected autoconf version
-EXPECTED_AUTOCONF_VERSION=2.59
-
# Global configuration variables
#
# NOTE: lazy_configure depends on '.' always being last directory
@@ -288,30 +285,6 @@ do_autoconf ()
create_lib_configure_in
distribute_config_helpers
- if target_contains win32; then
- # Select the correct autoconf on cygwin
- save_want_autoconf_ver=$WANT_AUTOCONF_VER
- WANT_AUTOCONF_VER=$EXPECTED_AUTOCONF_VERSION
- export WANT_AUTOCONF_VER
- fi
- exp_ac_vsn=$EXPECTED_AUTOCONF_VERSION
- ac_vsn_blob=`autoconf --version`
- ac_vsn=`echo x$ac_vsn_blob | sed "s|[^0-9]*\([0-9][^ \t\n]*\).*|\1|"`
- case "$ac_vsn" in
- $exp_ac_vsn)
- ;;
- *)
- echo "***************************************************" 1>&2
- echo "***************************************************" 1>&2
- echo "*** WARNING: System might fail to configure or" 1>&2
- echo "*** might be erroneously configured" 1>&2
- echo "*** since autoconf version $ac_vsn is used" 1>&2
- echo "*** instead of version $exp_ac_vsn!" 1>&2
- echo "***************************************************" 1>&2
- echo "***************************************************" 1>&2
- ;;
- esac
-
if [ ! -z "$OVERRIDE_CONFIGURE" ]; then
echo "Autoconf disabled on target $TARGET, but is performed on host" >&2
# We still use erts configure for erl_interface and VxWorks
@@ -346,11 +319,6 @@ do_autoconf ()
done
restore_vars OVERRIDE_TARGET TARGET
-
- if target_contains win32; then
- WANT_AUTOCONF_VER=$save_want_autoconf_ver
- export WANT_AUTOCONF_VER
- fi
}
run_configure ()
@@ -583,7 +551,6 @@ do_lazy_configure ()
CONFIGURE_DIR=$dir \
EXTRA_CONFIGURE_DEPENDENCIES=$xc_dep \
EXTRA_CONFIG_STATUS_DEPENDENCIES=$xcs_dep \
- EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \
lazy_configure
echo "=== Done configuring $dir"
echo ""
@@ -613,7 +580,6 @@ do_lazy_configure_clean ()
MAKE="$MAKE" TARGET=$TARGET \
ERL_TOP=$ERL_TOP \
CONFIGURE_DIR=$dir \
- EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \
lazy_configure_clean
echo "=== Done cleaning configure in $dir"
echo ""
@@ -644,7 +610,6 @@ do_lazy_configure_target_clean ()
MAKE="$MAKE" TARGET=$TARGET \
ERL_TOP=$ERL_TOP \
CONFIGURE_DIR=$dir \
- EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \
lazy_configure_target_clean
echo "=== Done target cleaning configure in $dir"
echo ""
diff --git a/otp_versions.table b/otp_versions.table
index e21ca7fdf4..dbc656a543 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,6 @@
+OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
+OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
+OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 :
OTP-19.1.6 : erts-8.1.1 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssh-4.3.6 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 :
OTP-19.1.5 : ssh-4.3.6 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 erts-8.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 :
@@ -14,6 +17,7 @@ OTP-19.0.3 : inets-6.3.2 kernel-5.0.1 ssl-8.0.1 # asn1-4.0.3 common_test-1.12.2
OTP-19.0.2 : compiler-7.0.1 erts-8.0.2 stdlib-3.0.1 # asn1-4.0.3 common_test-1.12.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0.1 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2.1 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3.1 ssl-8.0 syntax_tools-2.0 tools-2.8.5 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0.1 : dialyzer-3.0.1 erts-8.0.1 inets-6.3.1 observer-2.2.1 ssh-4.3.1 tools-2.8.5 # asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0 : asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 erts-8.0 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 tools-2.8.4 typer-0.9.11 wx-1.7 xmerl-1.3.11 # :
+OTP-18.3.4.5 : crypto-3.6.3.1 erts-7.3.1.3 inets-6.2.4.1 ssh-4.2.2.3 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.4 : erts-7.3.1.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.3 : ssh-4.2.2.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.2 : common_test-1.12.1.1 erts-7.3.1.1 ssl-7.3.3.1 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
diff --git a/scripts/build-otp b/scripts/build-otp
new file mode 100755
index 0000000000..da09fb8045
--- /dev/null
+++ b/scripts/build-otp
@@ -0,0 +1,39 @@
+#!/bin/bash
+
+function progress {
+ local file=$1
+ ls=$(ls -l $file)
+ while [ true ]; do
+ sleep 10
+ new_ls=$(ls -l $file)
+ if [ "$new_ls" != "$ls" ]; then
+ echo -n "."
+ fi
+ ls="$new_ls"
+ done
+}
+
+function do_and_log {
+ log="scripts/latest-log.$$"
+ echo "" >$log
+ echo -n "$1..."
+ (progress $log) &
+ pid=$!
+ disown
+ if ./otp_build $2 $3 >$log 2>&1; then
+ kill $pid >/dev/null 2>&1
+ echo " done."
+ else
+ kill $pid >/dev/null 2>&1
+ echo " failed."
+ tail -n 200 $log
+ echo "*** Failed ***"
+ exit 1
+ fi
+}
+
+do_and_log "Autoconfing" autoconf
+do_and_log "Configuring" configure
+do_and_log "Building OTP" boot -a
+
+exit 0
diff --git a/scripts/run-smoke-tests b/scripts/run-smoke-tests
new file mode 100755
index 0000000000..c2333e7825
--- /dev/null
+++ b/scripts/run-smoke-tests
@@ -0,0 +1,10 @@
+#!/bin/bash
+set -ev
+
+cd $ERL_TOP/release/tests/test_server
+$ERL_TOP/bin/erl -s ts install -s ts smoke_test batch -s init stop
+
+if grep -q '=failed *[1-9]' ct_run.test_server@*/*/run.*/suite.log; then
+ echo "One or more tests failed."
+ exit 1
+fi
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index f627145f9f..f4d84ab163 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -130,7 +130,7 @@ handle_event(EventType, EventContent, State, Data) ->
{next_state, NewState, NewData}
</pre>
<p>
- Se section
+ See section
<seealso marker="#One Event Handler">One Event Handler</seealso>
for an example.
</p>
@@ -887,7 +887,7 @@ stop() ->
</p>
<p>
This type of time-out is useful to for example act on inactivity.
- Let us start restart the code sequence
+ Let us restart the code sequence
if no button is pressed for say 30 seconds:
</p>
<code type="erl"><![CDATA[
@@ -1180,6 +1180,17 @@ open(state_timeout, lock, Data) ->
{next_state, locked, Data};
...
]]></code>
+ <p>
+ You can repeat the state entry code by returning one of
+ <c>{repeat_state, ...}</c>, <c>{repeat_state_and_data,_}</c>
+ or <c>repeat_state_and_data</c> that otherwise behaves
+ exactly like their <c>keep_state</c> siblings.
+ See the type
+ <seealso marker="stdlib:gen_statem#type-state_callback_result">
+ <c>state_callback_result()</c>
+ </seealso>
+ in the reference manual.
+ </p>
</section>
<!-- =================================================================== -->
diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml
index eee2648f34..e1760d0ded 100644
--- a/system/doc/efficiency_guide/advanced.xml
+++ b/system/doc/efficiency_guide/advanced.xml
@@ -87,15 +87,15 @@
</row>
<row>
<cell>Small Map</cell>
- <cell>4 words + 2 words per entry (key and value) + the size of each key and value pair.</cell>
+ <cell>5 words + the size of all keys and values.</cell>
</row>
<row>
- <cell>Large Map</cell>
+ <cell>Large Map (> 32 keys)</cell>
<cell>
- At least, 2 words + 2 x <c>N</c> words + 2 x log16(<c>N</c>) words +
- the size of each key and value pair, where <c>N</c> is the number of pairs in the Map.
- A large Map is represented as a tree internally where each node in the tree is a
- "sparse tuple" of arity 16.
+ <c>N</c> x <c>F</c> words + the size of all keys and values.<br></br>
+ <c>N</c> is the number of keys in the Map.<br></br>
+ <c>F</c> is a sparsity factor that can vary between 1.6 and 1.8
+ due to the probabilistic nature of the internal HAMT data structure.
</cell>
</row>
<row>
diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml
index ced584ed35..a0ea41cb3b 100644
--- a/system/doc/reference_manual/typespec.xml
+++ b/system/doc/reference_manual/typespec.xml
@@ -11,7 +11,7 @@
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
@@ -63,7 +63,7 @@
Types consist of, and are built from, a set of predefined types,
for example, <c>integer()</c>, <c>atom()</c>, and <c>pid()</c>.
Predefined types represent a typically infinite set of Erlang terms that
- belong to this type. For example, the type <c>atom()</c> stands for the
+ belong to this type. For example, the type <c>atom()</c> denotes the
set of all Erlang atoms.
</p>
<p>
@@ -131,19 +131,19 @@
| nonempty_improper_list(Type1, Type2) %% Type1 and Type2 as above
| nonempty_list(Type) %% Proper non-empty list
- Map :: map() %% stands for a map of any size
- | #{} %% stands for the empty map
+ Map :: map() %% denotes a map of any size
+ | #{} %% denotes the empty map
| #{PairList}
- Tuple :: tuple() %% stands for a tuple of any size
+ Tuple :: tuple() %% denotes a tuple of any size
| {}
| {TList}
PairList :: Pair
| Pair, PairList
- Pair :: Type := Type %% denotes a pair that must be present
- | Type => Type
+ Pair :: Type := Type %% denotes a mandatory pair
+ | Type => Type %% denotes an optional pair
TList :: Type
| Type, TList
@@ -161,7 +161,7 @@
that <c>M</c> or <c>N</c>, or both, are zero.
</p>
<p>
- Because lists are commonly used, they have shorthand type notations.
+ Because lists are commonly used, they have shorthand type notations.
The types <c>list(T)</c> and <c>nonempty_list(T)</c> have the shorthands
<c>[T]</c> and <c>[T,...]</c>, respectively.
The only difference between the two shorthands is that <c>[T]</c> can be an
@@ -169,14 +169,18 @@
</p>
<p>
Notice that the shorthand for <c>list()</c>, that is, the list of
- elements of unknown type, is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>.
+ elements of unknown type, is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>.
The notation <c>[]</c> specifies the singleton type for the empty list.
</p>
<p>
The general form of maps is <c>#{PairList}</c>. The key types in
<c>PairList</c> are allowed to overlap, and if they do, the
leftmost pair takes precedence. A map pair has a key in
- <c>PairList</c> if it belongs to this type.
+ <c>PairList</c> if it belongs to this type. A <c>PairList</c> may contain
+ both 'mandatory' and 'optional' pairs where 'mandatory' denotes that
+ a key type, and its associated value type, must be present.
+ In the case of an 'optional' pair it is not required for the key type to
+ be present.
</p>
<p>
Notice that the syntactic representation of <c>map()</c> is
@@ -184,8 +188,8 @@
The notation <c>#{}</c> specifies the singleton type for the empty map.
</p>
<p>
- For convenience, the following types are also built-in.
- They can be thought as predefined aliases for the type unions also shown in
+ For convenience, the following types are also built-in.
+ They can be thought as predefined aliases for the type unions also shown in
the table.
</p>
<table>
@@ -201,37 +205,37 @@
<row>
<cell><c>bitstring()</c></cell><cell><c>&lt;&lt;_:_*1&gt;&gt;</c></cell>
</row>
- <row>
+ <row>
<cell><c>boolean()</c></cell><cell><c>'false' | 'true'</c></cell>
</row>
- <row>
+ <row>
<cell><c>byte()</c></cell><cell><c>0..255</c></cell>
</row>
<row>
<cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell>
</row>
- <row>
+ <row>
<cell><c>nil()</c></cell><cell><c>[]</c></cell>
</row>
<row>
<cell><c>number()</c></cell><cell><c>integer() | float()</c></cell>
</row>
- <row>
+ <row>
<cell><c>list()</c></cell><cell><c>[any()]</c></cell>
</row>
- <row>
+ <row>
<cell><c>maybe_improper_list()</c></cell><cell><c>maybe_improper_list(any(), any())</c></cell>
</row>
- <row>
+ <row>
<cell><c>nonempty_list()</c></cell><cell><c>nonempty_list(any())</c></cell>
</row>
<row>
<cell><c>string()</c></cell><cell><c>[char()]</c></cell>
</row>
- <row>
+ <row>
<cell><c>nonempty_string()</c></cell><cell><c>[char(),...]</c></cell>
</row>
- <row>
+ <row>
<cell><c>iodata()</c></cell><cell><c>iolist() | binary()</c></cell>
</row>
<row>
@@ -243,7 +247,7 @@
<row>
<cell><c>module()</c></cell><cell><c>atom()</c></cell>
</row>
- <row>
+ <row>
<cell><c>mfa()</c></cell><cell><c>{module(),atom(),arity()}</c></cell>
</row>
<row>
@@ -259,7 +263,7 @@
<cell><c>timeout()</c></cell><cell><c>'infinity' | non_neg_integer()</c></cell>
</row>
<row>
- <cell><c>no_return()</c></cell><cell><c>none()</c></cell>
+ <cell><c>no_return()</c></cell><cell><c>none()</c></cell>
</row>
<tcaption>Built-in types, predefined aliases</tcaption>
</table>
@@ -284,11 +288,11 @@
</row>
<tcaption>Additional built-in types</tcaption>
</table>
-
+
<p>
Users are not allowed to define types with the same names as the
predefined or built-in ones. This is checked by the compiler and
- its violation results in a compilation error.
+ its violation results in a compilation error.
</p>
<note>
<p>
@@ -394,13 +398,13 @@
<pre>
-record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre>
<p>
- For fields without type annotations, their type defaults to any().
+ For fields without type annotations, their type defaults to any().
That is, the previous example is a shorthand for the following:
</p>
<pre>
-record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre>
<p>
- In the presence of initial values for fields,
+ In the presence of initial values for fields,
the type must be declared after the initialization, as follows:
</p>
<pre>
@@ -409,12 +413,12 @@
The initial values for fields are to be compatible
with (that is, a member of) the corresponding types.
This is checked by the compiler and results in a compilation error
- if a violation is detected.
+ if a violation is detected.
</p>
<note>
<p>Before Erlang/OTP 19, for fields without initial values,
the singleton type <c>'undefined'</c> was added to all declared types.
- In other words, the following two record declarations had identical
+ In other words, the following two record declarations had identical
effects:</p>
<pre>
-record(rec, {f1 = 42 :: integer(),
@@ -430,22 +434,22 @@
</p>
</note>
<p>
- Any record, containing type information or not, once defined,
+ Any record, containing type information or not, once defined,
can be used as a type using the following syntax:
</p>
<pre> #rec{}</pre>
<p>
- In addition, the record fields can be further specified when using
+ In addition, the record fields can be further specified when using
a record type by adding type information about the field
as follows:
</p>
<pre> #rec{some_field :: Type}</pre>
<p>
- Any unspecified fields are assumed to have the type in the original
+ Any unspecified fields are assumed to have the type in the original
record declaration.
</p>
</section>
-
+
<section>
<title>Specifications for Functions</title>
<p>
@@ -459,9 +463,9 @@
else a compilation error occurs.
</p>
<p>
- This form can also be used in header files (.hrl) to declare type
- information for exported functions.
- Then these header files can be included in files that (implicitly or
+ This form can also be used in header files (.hrl) to declare type
+ information for exported functions.
+ Then these header files can be included in files that (implicitly or
explicitly) import these functions.
</p>
<p>
@@ -475,14 +479,14 @@
<pre>
-spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre>
<p>
- A function specification can be overloaded.
+ A function specification can be overloaded.
That is, it can have several types, separated by a semicolon (<c>;</c>):
</p>
<pre>
-spec foo(T1, T2) -> T3
; (T4, T5) -> T6.</pre>
<p>
- A current restriction, which currently results in a warning
+ A current restriction, which currently results in a warning
(not an error) by the compiler, is that the domains of
the argument types cannot overlap.
For example, the following specification results in a warning:
@@ -491,9 +495,9 @@
-spec foo(pos_integer()) -> pos_integer()
; (integer()) -> integer().</pre>
<p>
- Type variables can be used in specifications to specify relations for
- the input and output arguments of a function.
- For example, the following specification defines the type of a
+ Type variables can be used in specifications to specify relations for
+ the input and output arguments of a function.
+ For example, the following specification defines the type of a
polymorphic identity function:
</p>
<pre>
@@ -542,8 +546,8 @@
-spec foo({X, integer()}) -> X when X :: atom()
; ([Y]) -> Y when Y :: number().</pre>
<p>
- Some functions in Erlang are not meant to return;
- either because they define servers or because they are used to
+ Some functions in Erlang are not meant to return;
+ either because they define servers or because they are used to
throw exceptions, as in the following function:
</p>
<pre> my_error(Err) -> erlang:throw({error, Err}).</pre>
@@ -555,4 +559,3 @@
<pre> -spec my_error(term()) -> no_return().</pre>
</section>
</chapter>
-
diff --git a/system/doc/tutorial/c_portdriver.xmlsrc b/system/doc/tutorial/c_portdriver.xmlsrc
index 933e2395a3..da680642b6 100644
--- a/system/doc/tutorial/c_portdriver.xmlsrc
+++ b/system/doc/tutorial/c_portdriver.xmlsrc
@@ -161,8 +161,8 @@ decode([Int]) -> Int.</pre>
<title>Running the Example</title>
<p><em>Step 1.</em> Compile the C code:</p>
<pre>
-unix> <input>gcc -o exampledrv -fpic -shared complex.c port_driver.c</input>
-windows> <input>cl -LD -MD -Fe exampledrv.dll complex.c port_driver.c</input></pre>
+unix> <input>gcc -o example_drv.so -fpic -shared complex.c port_driver.c</input>
+windows> <input>cl -LD -MD -Fe example_drv.dll complex.c port_driver.c</input></pre>
<p><em>Step 2.</em> Start Erlang and compile the Erlang code:</p>
<pre>
> <input>erl</input>